Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModPartitionRegion.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 to partition region.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModPartitionRegion.F90,v 1.17 2008/12/06 08:45:03 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2004-2005 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modpartitionregion
40 
41  USE modglobal, ONLY: t_global
42  USE moddatatypes
43  USE modparameters
44  USE moderror
45  USE modbndpatch, ONLY: t_patch
46  USE moddatastruct, ONLY: t_level,t_region
47  USE modgrid, ONLY: t_grid
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52  PRIVATE
53  PUBLIC :: rflu_part_addvirtualcells, &
54  rflu_part_buildborderfacelist, &
55  rflu_part_buildcelllists, &
56  rflu_part_buildpatchlists, &
57  rflu_part_buildvertexdata, &
58  rflu_part_buildvertexlists, &
59  rflu_part_buildreg2cellmap, &
60  rflu_part_createcelllists, &
61  rflu_part_createpatchlists, &
62  rflu_part_createreg2cellmap, &
63  rflu_part_destroycelldata, &
64  rflu_part_destroyborderfacelist, &
65  rflu_part_destroycelllists, &
66  rflu_part_destroypatchlists, &
67  rflu_part_destroyvertexdata, &
68  rflu_part_partitionregion, &
69  rflu_part_renumbervertexlists
70 
71 ! ******************************************************************************
72 ! Declarations and definitions
73 ! ******************************************************************************
74 
75  CHARACTER(CHRLEN) :: &
76  RCSIdentString = '$RCSfile: RFLU_ModPartitionRegion.F90,v $ $Revision: 1.17 $'
77 
78 
79 ! ******************************************************************************
80 ! Routines
81 ! ******************************************************************************
82 
83  CONTAINS
84 
85 
86 
87 
88 
89 
90 ! ******************************************************************************
91 !
92 ! Purpose: Add virtual cells.
93 !
94 ! Description: None.
95 !
96 ! Input:
97 ! pRegion Pointer to region
98 ! pRegionSerial Pointer to serial region
99 !
100 ! Output: None.
101 !
102 ! Notes: None.
103 !
104 ! ******************************************************************************
105 
106  SUBROUTINE rflu_part_addvirtualcells(pRegion,pRegionSerial)
107 
108  USE modsortsearch
109 
110  USE rflu_modhashtable
111  USE rflu_modpartitionregionutils, ONLY: rflu_part_addvirtualcellsinv1, &
112  rflu_part_addvirtualcellsinv2
113 
114  IMPLICIT NONE
115 
116 ! ******************************************************************************
117 ! Declarations and definitions
118 ! ******************************************************************************
119 
120 ! ==============================================================================
121 ! Arguments
122 ! ==============================================================================
123 
124  TYPE(t_region), POINTER :: pregion,pregionserial
125 
126 ! ==============================================================================
127 ! Locals
128 ! ==============================================================================
129 
130  INTEGER :: errorflag,i,icg,icg2,icl,ict,ilayer,iloc,ireg,j,key, &
131  ncellsvirt,ncellsvirtmax,nlayers
132  INTEGER, DIMENSION(:), ALLOCATABLE :: vc
133  TYPE(t_grid), POINTER :: pgrid,pgridserial
134  TYPE(t_global), POINTER :: global
135 
136 ! ******************************************************************************
137 ! Start
138 ! ******************************************************************************
139 
140  global => pregionserial%global
141 
142  CALL registerfunction(global,'RFLU_PART_AddVirtualCells',&
143  'RFLU_ModPartitionRegion.F90')
144 
145  IF ( global%verbLevel > verbose_none ) THEN
146  WRITE(stdout,'(A,1X,A)') solver_name,'Adding virtual cells...'
147  END IF ! global%verbLevel
148 
149  IF ( global%verbLevel > verbose_low ) THEN
150  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
151  pregion%iRegionGlobal
152  END IF ! global%verbLevel
153 
154 ! ******************************************************************************
155 ! Set pointers
156 ! ******************************************************************************
157 
158  pgrid => pregion%grid
159  pgridserial => pregionserial%grid
160 
161 ! ******************************************************************************
162 ! Build list of virtual cells
163 ! ******************************************************************************
164 
165  ncellsvirtmax = pgrid%nCellsMax - pgrid%nCells
166 
167  ALLOCATE(vc(ncellsvirtmax),stat=errorflag)
168  global%error = errorflag
169  IF ( global%error /= err_none ) THEN
170  CALL errorstop(global,err_allocate,__line__,'vc')
171  END IF ! global%error
172 
173  IF ( pregionserial%mixtInput%spaceOrder > 1 ) THEN
174  CALL rflu_part_addvirtualcellsinv2(pregion,pregionserial,vc, &
175  ncellsvirtmax,ncellsvirt)
176  ELSE
177  CALL rflu_part_addvirtualcellsinv1(pregion,pregionserial,vc, &
178  ncellsvirtmax,ncellsvirt)
179  END IF ! pRegionSerial%mixtInput%spaceOrder
180 
181 ! ******************************************************************************
182 ! Loop over list of virtual cells, add to connectivity lists according to
183 ! cell type
184 ! ******************************************************************************
185 
186  DO i = 1,ncellsvirt
187  icg = vc(i)
188 
189  ict = pgridserial%cellGlob2Loc(1,icg)
190  icl = pgridserial%cellGlob2Loc(2,icg)
191 
192 ! ==============================================================================
193 ! Specify connectivity and set local-to-global mapping
194 ! ==============================================================================
195 
196  SELECT CASE ( ict )
197 
198 ! ------------------------------------------------------------------------------
199 ! Tetrahedra
200 ! ------------------------------------------------------------------------------
201 
202  CASE ( cell_type_tet )
203  IF ( pgrid%nTetsTot == pgrid%nTetsMax ) THEN
204  global%warnCounter = global%warnCounter + 1
205 
206  IF ( global%verbLevel > verbose_low ) THEN
207  WRITE(stdout,'(A,3X,A)') solver_name, &
208  '*** WARNING *** About to exceed tetrahedra list dimensions.'
209  WRITE(stdout,'(A,3X,A)') solver_name, &
210  ' Increasing list dimensions and continuing.'
211  END IF ! global
212 
213  CALL rflu_part_recreatecelllist(global,4,pgrid%nTetsMax, &
214  pgrid%tet2v,pgrid%tet2CellGlob)
215  END IF ! pGrid%nTetsTot
216 
217  pgrid%nCellsTot = pgrid%nCellsTot + 1
218  pgrid%nTetsTot = pgrid%nTetsTot + 1
219 
220  pgrid%tet2v(1,pgrid%nTetsTot) = pgridserial%tet2v(1,icl)
221  pgrid%tet2v(2,pgrid%nTetsTot) = pgridserial%tet2v(2,icl)
222  pgrid%tet2v(3,pgrid%nTetsTot) = pgridserial%tet2v(3,icl)
223  pgrid%tet2v(4,pgrid%nTetsTot) = pgridserial%tet2v(4,icl)
224 
225  pgrid%cellGlob2Loc(1,pgrid%nCellsTot) = cell_type_tet
226  pgrid%cellGlob2Loc(2,pgrid%nCellsTot) = pgrid%nTetsTot
227 
228  pgrid%tet2CellGlob(pgrid%nTetsTot) = pgrid%nCellsTot
229 
230 ! ------------------------------------------------------------------------------
231 ! Hexahedra
232 ! ------------------------------------------------------------------------------
233 
234  CASE ( cell_type_hex )
235  IF ( pgrid%nHexsTot == pgrid%nHexsMax ) THEN
236  global%warnCounter = global%warnCounter + 1
237 
238  IF ( global%verbLevel > verbose_low ) THEN
239  WRITE(stdout,'(A,3X,A)') solver_name, &
240  '*** WARNING *** About to exceed hexahedra list dimensions.'
241  WRITE(stdout,'(A,3X,A)') solver_name, &
242  ' Increasing list dimensions and continuing.'
243  END IF ! global
244 
245  CALL rflu_part_recreatecelllist(global,8,pgrid%nHexsMax, &
246  pgrid%hex2v,pgrid%hex2CellGlob)
247  END IF ! pGrid%nHexsTot
248 
249  pgrid%nCellsTot = pgrid%nCellsTot + 1
250  pgrid%nHexsTot = pgrid%nHexsTot + 1
251 
252  pgrid%hex2v(1,pgrid%nHexsTot) = pgridserial%hex2v(1,icl)
253  pgrid%hex2v(2,pgrid%nHexsTot) = pgridserial%hex2v(2,icl)
254  pgrid%hex2v(3,pgrid%nHexsTot) = pgridserial%hex2v(3,icl)
255  pgrid%hex2v(4,pgrid%nHexsTot) = pgridserial%hex2v(4,icl)
256  pgrid%hex2v(5,pgrid%nHexsTot) = pgridserial%hex2v(5,icl)
257  pgrid%hex2v(6,pgrid%nHexsTot) = pgridserial%hex2v(6,icl)
258  pgrid%hex2v(7,pgrid%nHexsTot) = pgridserial%hex2v(7,icl)
259  pgrid%hex2v(8,pgrid%nHexsTot) = pgridserial%hex2v(8,icl)
260 
261  pgrid%cellGlob2Loc(1,pgrid%nCellsTot) = cell_type_hex
262  pgrid%cellGlob2Loc(2,pgrid%nCellsTot) = pgrid%nHexsTot
263 
264  pgrid%hex2CellGlob(pgrid%nHexsTot) = pgrid%nCellsTot
265 
266 ! ------------------------------------------------------------------------------
267 ! Prisms
268 ! ------------------------------------------------------------------------------
269 
270  CASE ( cell_type_pri )
271  IF ( pgrid%nPrisTot == pgrid%nPrisMax ) THEN
272  global%warnCounter = global%warnCounter + 1
273 
274  IF ( global%verbLevel > verbose_low ) THEN
275  WRITE(stdout,'(A,3X,A)') solver_name, &
276  '*** WARNING *** About to exceed prism list dimensions.'
277  WRITE(stdout,'(A,3X,A)') solver_name, &
278  ' Increasing list dimensions and continuing.'
279  END IF ! global
280 
281  CALL rflu_part_recreatecelllist(global,6,pgrid%nPrisMax, &
282  pgrid%pri2v,pgrid%pri2CellGlob)
283  END IF ! pGrid%nPrisTot
284 
285  pgrid%nCellsTot = pgrid%nCellsTot + 1
286  pgrid%nPrisTot = pgrid%nPrisTot + 1
287 
288  pgrid%pri2v(1,pgrid%nPrisTot) = pgridserial%pri2v(1,icl)
289  pgrid%pri2v(2,pgrid%nPrisTot) = pgridserial%pri2v(2,icl)
290  pgrid%pri2v(3,pgrid%nPrisTot) = pgridserial%pri2v(3,icl)
291  pgrid%pri2v(4,pgrid%nPrisTot) = pgridserial%pri2v(4,icl)
292  pgrid%pri2v(5,pgrid%nPrisTot) = pgridserial%pri2v(5,icl)
293  pgrid%pri2v(6,pgrid%nPrisTot) = pgridserial%pri2v(6,icl)
294 
295  pgrid%cellGlob2Loc(1,pgrid%nCellsTot) = cell_type_pri
296  pgrid%cellGlob2Loc(2,pgrid%nCellsTot) = pgrid%nPrisTot
297 
298  pgrid%pri2CellGlob(pgrid%nPrisTot) = pgrid%nCellsTot
299 
300 ! ------------------------------------------------------------------------------
301 ! Pyramids
302 ! ------------------------------------------------------------------------------
303 
304  CASE ( cell_type_pyr )
305  IF ( pgrid%nPyrsTot == pgrid%nPyrsMax ) THEN
306  global%warnCounter = global%warnCounter + 1
307 
308  IF ( global%verbLevel > verbose_low ) THEN
309  WRITE(stdout,'(A,3X,A)') solver_name, &
310  '*** WARNING *** About to exceed pyramid list dimensions.'
311  WRITE(stdout,'(A,3X,A)') solver_name, &
312  ' Increasing list dimensions and continuing.'
313  END IF ! global
314 
315  CALL rflu_part_recreatecelllist(global,5,pgrid%nPyrsMax, &
316  pgrid%pyr2v,pgrid%pyr2CellGlob)
317  END IF ! pGrid%nPyrsTot
318 
319  pgrid%nCellsTot = pgrid%nCellsTot + 1
320  pgrid%nPyrsTot = pgrid%nPyrsTot + 1
321 
322  pgrid%pyr2v(1,pgrid%nPyrsTot) = pgridserial%pyr2v(1,icl)
323  pgrid%pyr2v(2,pgrid%nPyrsTot) = pgridserial%pyr2v(2,icl)
324  pgrid%pyr2v(3,pgrid%nPyrsTot) = pgridserial%pyr2v(3,icl)
325  pgrid%pyr2v(4,pgrid%nPyrsTot) = pgridserial%pyr2v(4,icl)
326  pgrid%pyr2v(5,pgrid%nPyrsTot) = pgridserial%pyr2v(5,icl)
327 
328  pgrid%cellGlob2Loc(1,pgrid%nCellsTot) = cell_type_pyr
329  pgrid%cellGlob2Loc(2,pgrid%nCellsTot) = pgrid%nPyrsTot
330 
331  pgrid%pyr2CellGlob(pgrid%nPyrsTot) = pgrid%nCellsTot
332 
333 ! ------------------------------------------------------------------------------
334 ! Default
335 ! ------------------------------------------------------------------------------
336 
337  CASE default
338  CALL errorstop(global,err_reached_default,__line__)
339  END SELECT ! pGridSerial%cellGlob2Loc
340 
341 ! ==============================================================================
342 ! Update mapping from partitioned cells to serial cells
343 ! ==============================================================================
344 
345  pgrid%pc2sc(pgrid%nCellsTot) = icg
346  END DO ! icl
347 
348 ! ******************************************************************************
349 ! Deallocate temporary memory for virtual cells
350 ! ******************************************************************************
351 
352  DEALLOCATE(vc,stat=errorflag)
353  global%error = errorflag
354  IF ( global%error /= err_none ) THEN
355  CALL errorstop(global,err_deallocate,__line__,'virtCells')
356  END IF ! global%error
357 
358 ! ******************************************************************************
359 ! Write information about numbers of virtual cells
360 ! ******************************************************************************
361 
362  IF ( global%verbLevel > verbose_low ) THEN
363  WRITE(stdout,'(A,3X,A)') solver_name,'Virtual cell statistics:'
364  WRITE(stdout,'(A,5X,A,1X,I6)') solver_name,'Tetrahedra:', &
365  pgrid%nTetsTot-pgrid%nTets
366  WRITE(stdout,'(A,5X,A,1X,I6)') solver_name,'Hexahedra: ', &
367  pgrid%nHexsTot-pgrid%nHexs
368  WRITE(stdout,'(A,5X,A,1X,I6)') solver_name,'Prisms: ', &
369  pgrid%nPrisTot-pgrid%nPris
370  WRITE(stdout,'(A,5X,A,1X,I6)') solver_name,'Pyramids: ', &
371  pgrid%nPyrsTot-pgrid%nPyrs
372  END IF ! global%verbLevel
373 
374 ! ******************************************************************************
375 ! End
376 ! ******************************************************************************
377 
378  IF ( global%verbLevel > verbose_none ) THEN
379  WRITE(stdout,'(A,1X,A)') solver_name,'Adding virtual cells done.'
380  END IF ! global%verbLevel
381 
382  CALL deregisterfunction(global)
383 
384  END SUBROUTINE rflu_part_addvirtualcells
385 
386 
387 
388 
389 
390 
391 
392 ! ******************************************************************************
393 !
394 ! Purpose: Build border face lists.
395 !
396 ! Description: None.
397 !
398 ! Input:
399 ! pRegion Pointer to region
400 !
401 ! Output: None.
402 !
403 ! Notes: None.
404 !
405 ! ******************************************************************************
406 
407  SUBROUTINE rflu_part_buildborderfacelist(pRegion)
408 
409  IMPLICIT NONE
410 
411 ! ******************************************************************************
412 ! Declarations and definitions
413 ! ******************************************************************************
414 
415 ! ==============================================================================
416 ! Arguments
417 ! ==============================================================================
418 
419  TYPE(t_region), POINTER :: pregion
420 
421 ! ==============================================================================
422 ! Locals
423 ! ==============================================================================
424 
425  CHARACTER(CHRLEN) :: errorstring
426  INTEGER :: c1,c2,errorflag,ifg,ifl,ireg,ireg1,ireg2,nfacescut
427  INTEGER, DIMENSION(:,:), ALLOCATABLE :: avf
428  TYPE(t_grid), POINTER :: pgrid
429  TYPE(t_global), POINTER :: global
430 
431 ! ******************************************************************************
432 ! Start
433 ! ******************************************************************************
434 
435  global => pregion%global
436 
437  CALL registerfunction(global,'RFLU_PART_BuildBorderFaceList',&
438  'RFLU_ModPartitionRegion.F90')
439 
440  IF ( global%verbLevel > verbose_none ) THEN
441  WRITE(stdout,'(A,1X,A)') solver_name,'Building border face lists...'
442  END IF ! global%verbLevel
443 
444  IF ( global%verbLevel > verbose_low ) THEN
445  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
446  pregion%iRegionGlobal
447  END IF ! global%verbLevel
448 
449 ! ******************************************************************************
450 ! Set pointers
451 ! ******************************************************************************
452 
453  pgrid => pregion%grid
454 
455 ! ******************************************************************************
456 ! Extract list of ALL actual-virtual faces. NOTE number of cut faces is known
457 ! from partitioning call.
458 ! ******************************************************************************
459 
460  ALLOCATE(pgrid%avf(3,pgrid%nFacesCut),stat=errorflag)
461  global%error = errorflag
462  IF ( global%error /= err_none ) THEN
463  CALL errorstop(global,err_allocate,__line__,'pGrid%avf')
464  END IF ! global%error
465 
466  nfacescut = 0
467 
468  DO ifg = 1,pgrid%nFaces + pgrid%nFacesVV
469  c1 = pgrid%f2c(1,ifg)
470  c2 = pgrid%f2c(2,ifg)
471 
472  IF ( pgrid%sc2r(c1) /= pgrid%sc2r(c2) ) THEN
473  nfacescut = nfacescut + 1
474 
475  pgrid%avf(1,nfacescut) = ifg
476  pgrid%avf(2,nfacescut) = pgrid%sc2r(c1)
477  pgrid%avf(3,nfacescut) = pgrid%sc2r(c2)
478  END IF ! pGrid%sc2r
479  END DO ! ifg
480 
481  IF ( nfacescut /= pgrid%nFacesCut ) THEN
482  WRITE(errorstring,'(2(1X,I6))') nfacescut,pgrid%nFacesCut
483  CALL errorstop(global,err_nfacescut_invalid,__line__,trim(errorstring))
484  END IF ! nFacesCut
485 
486 ! ******************************************************************************
487 ! Cast list of actual-virtual faces in CSR form so each region can access
488 ! its actual-virtual faces directly
489 ! ******************************************************************************
490 
491 ! ==============================================================================
492 ! Allocate memory for CSR access array and count number of cut faces for each
493 ! region. NOTE this leads to duplicated faces, but more convenient to access
494 ! that way.
495 ! ==============================================================================
496 
497  ALLOCATE(pgrid%avfCSRInfo(global%nRegionsLocal),stat=errorflag)
498  global%error = errorflag
499  IF ( global%error /= err_none ) THEN
500  CALL errorstop(global,err_allocate,__line__,'pGrid%avfCSRInfo')
501  END IF ! global%error
502 
503  DO ireg = 1,global%nRegionsLocal
504  pgrid%avfCSRInfo(ireg) = 0
505  END DO ! iReg
506 
507  DO ifl = 1,pgrid%nFacesCut
508  ireg1 = pgrid%avf(2,ifl)
509  ireg2 = pgrid%avf(3,ifl)
510 
511  pgrid%avfCSRInfo(ireg1) = pgrid%avfCSRInfo(ireg1) + 1
512  pgrid%avfCSRInfo(ireg2) = pgrid%avfCSRInfo(ireg2) + 1
513  END DO ! ifl
514 
515 ! ==============================================================================
516 ! Sum number of cut faces for each region (after adding offset) so that can
517 ! count down when building list and get CSAR access array pointing to first
518 ! entry for each region.
519 ! ==============================================================================
520 
521  pgrid%avfCSRInfo(1) = pgrid%avfCSRInfo(1) + 1
522 
523  DO ireg = 2,global%nRegionsLocal
524  pgrid%avfCSRInfo(ireg) = pgrid%avfCSRInfo(ireg ) &
525  + pgrid%avfCSRInfo(ireg-1)
526  END DO ! iReg
527 
528 ! ==============================================================================
529 ! Build actual-virtual face list in CSR format
530 ! ==============================================================================
531 
532  ALLOCATE(pgrid%avfCSR(2*pgrid%nFacesCut),stat=errorflag)
533  global%error = errorflag
534  IF ( global%error /= err_none ) THEN
535  CALL errorstop(global,err_allocate,__line__,'pGrid%avfCSR')
536  END IF ! global%error
537 
538  DO ifl = 1,pgrid%nFacesCut
539  ifg = pgrid%avf(1,ifl)
540  ireg1 = pgrid%avf(2,ifl)
541  ireg2 = pgrid%avf(3,ifl)
542 
543  pgrid%avfCSRInfo(ireg1) = pgrid%avfCSRInfo(ireg1) - 1
544  pgrid%avfCSRInfo(ireg2) = pgrid%avfCSRInfo(ireg2) - 1
545 
546  pgrid%avfCSR(pgrid%avfCSRInfo(ireg1)) = ifg
547  pgrid%avfCSR(pgrid%avfCSRInfo(ireg2)) = ifg
548  END DO ! ifl
549 
550 ! ******************************************************************************
551 ! Deallocate original list
552 ! ******************************************************************************
553 
554  DEALLOCATE(pgrid%avf,stat=errorflag)
555  global%error = errorflag
556  IF ( global%error /= err_none ) THEN
557  CALL errorstop(global,err_deallocate,__line__,'pGrid%avf')
558  END IF ! global%error
559 
560 ! ******************************************************************************
561 ! End
562 ! ******************************************************************************
563 
564  IF ( global%verbLevel > verbose_none ) THEN
565  WRITE(stdout,'(A,1X,A)') solver_name,'Building border face lists done.'
566  END IF ! global%verbLevel
567 
568  CALL deregisterfunction(global)
569 
570  END SUBROUTINE rflu_part_buildborderfacelist
571 
572 
573 
574 
575 
576 
577 
578 
579 ! ******************************************************************************
580 !
581 ! Purpose: Build cell lists.
582 !
583 ! Description: None.
584 !
585 ! Input:
586 ! pRegion Pointer to region
587 ! pRegionSerial Pointer to serial region
588 !
589 ! Output: None.
590 !
591 ! Notes: None.
592 !
593 ! ******************************************************************************
594 
595  SUBROUTINE rflu_part_buildcelllists(pRegion,pRegionSerial)
596 
597  IMPLICIT NONE
598 
599 ! ******************************************************************************
600 ! Declarations and definitions
601 ! ******************************************************************************
602 
603 ! ==============================================================================
604 ! Arguments
605 ! ==============================================================================
606 
607  TYPE(t_region), POINTER :: pregion,pregionserial
608 
609 ! ==============================================================================
610 ! Locals
611 ! ==============================================================================
612 
613  INTEGER :: errorflag,i,ibeg,icg,icg2,icl,icl2,ict,iend,ireg,nhexsact, &
614  nhexsvir,nprisact,nprisvir,npyrsact,npyrsvir,ntetsact,ntetsvir
615  TYPE(t_grid), POINTER :: pgrid,pgridserial
616  TYPE(t_global), POINTER :: global
617 
618 ! ******************************************************************************
619 ! Start
620 ! ******************************************************************************
621 
622  global => pregion%global
623 
624  CALL registerfunction(global,'RFLU_PART_BuildCellLists',&
625  'RFLU_ModPartitionRegion.F90')
626 
627  IF ( global%verbLevel > verbose_none ) THEN
628  WRITE(stdout,'(A,1X,A)') solver_name,'Building cell lists...'
629  END IF ! global%verbLevel
630 
631  IF ( global%verbLevel > verbose_low ) THEN
632  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
633  pregion%iRegionGlobal
634  END IF ! global%verbLevel
635 
636 ! ******************************************************************************
637 ! Set pointers
638 ! ******************************************************************************
639 
640  pgrid => pregion%grid
641  pgridserial => pregionserial%grid
642 
643 ! ******************************************************************************
644 ! Get cell connectivity. NOTE at this stage the cell connectivity is still
645 ! given in terms of the vertex numbers of the serial region.
646 ! ******************************************************************************
647 
648  ntetsact = 0
649  ntetsvir = 0
650 
651  nhexsact = 0
652  nhexsvir = 0
653 
654  nprisact = 0
655  nprisvir = 0
656 
657  npyrsact = 0
658  npyrsvir = 0
659 
660  ireg = pregion%iRegionGlobal
661  ibeg = pgridserial%r2pcCSRInfo(ireg)
662 
663  IF ( ireg /= global%nRegionsLocal ) THEN
664  iend = pgridserial%r2pcCSRInfo(ireg+1)-1
665  ELSE
666  iend = pgridserial%nCellsTot
667  END IF ! iReg
668 
669  DO i = ibeg,iend
670  icg = pgridserial%r2pcCSR(i)
671 
672  ict = pgridserial%cellGlob2Loc(1,icg)
673  icl = pgridserial%cellGlob2Loc(2,icg)
674 
675  SELECT CASE ( ict )
676 
677 ! ------------------------------------------------------------------------------
678 ! Tetrahedra
679 ! ------------------------------------------------------------------------------
680 
681  CASE ( cell_type_tet )
682  IF ( icl <= pgridserial%nTets ) THEN
683  ntetsact = ntetsact + 1
684  icl2 = ntetsact
685  ELSE
686  ntetsvir = ntetsvir + 1
687  icl2 = ntetsvir + pgrid%nTets
688  END IF ! icl
689 
690  pgrid%tet2v(1,icl2) = pgridserial%tet2v(1,icl)
691  pgrid%tet2v(2,icl2) = pgridserial%tet2v(2,icl)
692  pgrid%tet2v(3,icl2) = pgridserial%tet2v(3,icl)
693  pgrid%tet2v(4,icl2) = pgridserial%tet2v(4,icl)
694 
695  icg2 = pgrid%tet2CellGlob(icl2)
696 
697  pgrid%pc2sc(icg2) = icg
698 
699 ! ------------------------------------------------------------------------------
700 ! Hexahedra
701 ! ------------------------------------------------------------------------------
702 
703  CASE ( cell_type_hex )
704  IF ( icl <= pgridserial%nHexs ) THEN
705  nhexsact = nhexsact + 1
706  icl2 = nhexsact
707  ELSE
708  nhexsvir = nhexsvir + 1
709  icl2 = nhexsvir + pgrid%nHexs
710  END IF ! icl
711 
712  pgrid%hex2v(1,icl2) = pgridserial%hex2v(1,icl)
713  pgrid%hex2v(2,icl2) = pgridserial%hex2v(2,icl)
714  pgrid%hex2v(3,icl2) = pgridserial%hex2v(3,icl)
715  pgrid%hex2v(4,icl2) = pgridserial%hex2v(4,icl)
716  pgrid%hex2v(5,icl2) = pgridserial%hex2v(5,icl)
717  pgrid%hex2v(6,icl2) = pgridserial%hex2v(6,icl)
718  pgrid%hex2v(7,icl2) = pgridserial%hex2v(7,icl)
719  pgrid%hex2v(8,icl2) = pgridserial%hex2v(8,icl)
720 
721  icg2 = pgrid%hex2CellGlob(icl2)
722 
723  pgrid%pc2sc(icg2) = icg
724 
725 ! ------------------------------------------------------------------------------
726 ! Prisms
727 ! ------------------------------------------------------------------------------
728 
729  CASE ( cell_type_pri )
730  IF ( icl <= pgridserial%nPris ) THEN
731  nprisact = nprisact + 1
732  icl2 = nprisact
733  ELSE
734  nprisvir = nprisvir + 1
735  icl2 = nprisvir + pgrid%nPris
736  END IF ! icl
737 
738  pgrid%pri2v(1,icl2) = pgridserial%pri2v(1,icl)
739  pgrid%pri2v(2,icl2) = pgridserial%pri2v(2,icl)
740  pgrid%pri2v(3,icl2) = pgridserial%pri2v(3,icl)
741  pgrid%pri2v(4,icl2) = pgridserial%pri2v(4,icl)
742  pgrid%pri2v(5,icl2) = pgridserial%pri2v(5,icl)
743  pgrid%pri2v(6,icl2) = pgridserial%pri2v(6,icl)
744 
745  icg2 = pgrid%pri2CellGlob(icl2)
746 
747  pgrid%pc2sc(icg2) = icg
748 
749 ! ------------------------------------------------------------------------------
750 ! Pyramids
751 ! ------------------------------------------------------------------------------
752 
753  CASE ( cell_type_pyr )
754  IF ( icl <= pgridserial%nPyrs ) THEN
755  npyrsact = npyrsact + 1
756  icl2 = npyrsact
757  ELSE
758  npyrsvir = npyrsvir + 1
759  icl2 = npyrsvir + pgrid%nPyrs
760  END IF ! icl
761 
762  pgrid%pyr2v(1,icl2) = pgridserial%pyr2v(1,icl)
763  pgrid%pyr2v(2,icl2) = pgridserial%pyr2v(2,icl)
764  pgrid%pyr2v(3,icl2) = pgridserial%pyr2v(3,icl)
765  pgrid%pyr2v(4,icl2) = pgridserial%pyr2v(4,icl)
766  pgrid%pyr2v(5,icl2) = pgridserial%pyr2v(5,icl)
767 
768  icg2 = pgrid%pyr2CellGlob(icl2)
769 
770  pgrid%pc2sc(icg2) = icg
771 
772 ! ------------------------------------------------------------------------------
773 ! Default
774 ! ------------------------------------------------------------------------------
775 
776  CASE default
777  CALL errorstop(global,err_reached_default,__line__)
778  END SELECT ! ict
779  END DO ! i
780 
781 ! ******************************************************************************
782 ! End
783 ! ******************************************************************************
784 
785  IF ( global%verbLevel > verbose_none ) THEN
786  WRITE(stdout,'(A,1X,A)') solver_name,'Building cell lists done.'
787  END IF ! global%verbLevel
788 
789  CALL deregisterfunction(global)
790 
791  END SUBROUTINE rflu_part_buildcelllists
792 
793 
794 
795 
796 
797 
798 
799 
800 
801 
802 
803 ! ******************************************************************************
804 !
805 ! Purpose: Build patch lists.
806 !
807 ! Description: None.
808 !
809 ! Input:
810 ! pRegion Pointer to region
811 ! pRegionSerial Pointer to serial region
812 !
813 ! Output: None.
814 !
815 ! Notes:
816 ! 1. At the end of this routine, the face lists of the partitioned region are
817 ! still in terms of the vertex numbers of the serial region.
818 !
819 ! ******************************************************************************
820 
821  SUBROUTINE rflu_part_buildpatchlists(pRegion,pRegionSerial)
822 
823  USE modsortsearch
824 
825  IMPLICIT NONE
826 
827 ! ******************************************************************************
828 ! Declarations and definitions
829 ! ******************************************************************************
830 
831 ! ==============================================================================
832 ! Arguments
833 ! ==============================================================================
834 
835  TYPE(t_region), POINTER :: pregion,pregionserial
836 
837 ! ==============================================================================
838 ! Locals
839 ! ==============================================================================
840 
841  INTEGER :: errorflag,icg,icgmax,icgmin,icg2,icl,ict,ifl,ifl2,iloc,ipatch, &
842  ireg,nbquadsact,nbquadsvir,nbtrisact,nbtrisvir,offs,v1g,v2g, &
843  v3g,v4g
844  TYPE(t_grid), POINTER :: pgrid,pgridserial
845  TYPE(t_global), POINTER :: global
846  TYPE(t_patch), POINTER :: ppatch,ppatchserial
847 
848 ! ******************************************************************************
849 ! Start
850 ! ******************************************************************************
851 
852  global => pregion%global
853 
854  CALL registerfunction(global,'RFLU_PART_BuildPatchLists',&
855  'RFLU_ModPartitionRegion.F90')
856 
857  IF ( global%verbLevel > verbose_none ) THEN
858  WRITE(stdout,'(A,1X,A)') solver_name,'Building patch lists...'
859  END IF ! global%verbLevel
860 
861  IF ( global%verbLevel > verbose_low ) THEN
862  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
863  pregion%iRegionGlobal
864  END IF ! global%verbLevel
865 
866 ! ******************************************************************************
867 ! Set pointers
868 ! ******************************************************************************
869 
870  pgrid => pregion%grid
871  pgridserial => pregionserial%grid
872 
873 ! ******************************************************************************
874 ! Loop over serial patches and set variables if that patch exists on this
875 ! partition
876 ! ******************************************************************************
877 
878  icgmin = minval(pgrid%sbc2pc(1:1,1:pgrid%nBCellsTot))
879  icgmax = maxval(pgrid%sbc2pc(1:1,1:pgrid%nBCellsTot))
880 
881  DO ipatch = 1,pgrid%nPatches
882  ppatch => pregion%patches(ipatch)
883 
884  ppatchserial => pregionserial%patches(ppatch%iPatchGlobal)
885 
886  ppatch%bcType = ppatchserial%bcType ! Required for sype cases
887 
888  nbtrisact = 0
889  nbtrisvir = 0
890 
891  nbquadsact = 0
892  nbquadsvir = 0
893 
894  offs = pgrid%pbf2sbfCSRInfo(ipatch) - 1
895 
896 ! ==============================================================================
897 ! Non-virtual patch. Treat patches differently because every cell in
898 ! partitioned region must be adjacent to virtual patches, so searching is
899 ! not necessary. NOTE that it is not necessary to distinguish between the
900 ! two cases for correct running of the code, it is only done for efficiency.
901 ! ==============================================================================
902 
903  IF ( ppatchserial%bcType /= bc_virtual ) THEN
904  DO ifl = 1,ppatchserial%nBFacesTot
905  icg = ppatchserial%bf2c(ifl)
906  ireg = pgridserial%sc2r(icg)
907 
908 ! ------------------------------------------------------------------------------
909 ! Find whether cell adjacent to boundary face exists in cell list
910 ! ------------------------------------------------------------------------------
911 
912  IF ( icg >= icgmin .AND. icg <= icgmax ) THEN ! Search
913  CALL binarysearchinteger(pgrid%sbc2pc(1:1,1:pgrid%nBCellsTot), &
914  pgrid%nBCellsTot,icg,iloc)
915  ELSE ! No need to search
916  iloc = element_not_found
917  END IF ! icg
918 
919 ! ------- Cell exists, so add face to boundary-face lists ----------------------
920 
921  IF ( iloc /= element_not_found ) THEN
922  icg2 = pgrid%sbc2pc(2,iloc)
923 
924  IF ( icg2 <= pgrid%nCells ) THEN ! Actual-boundary face
925  IF ( ppatchserial%bf2v(4,ifl) == vert_none ) THEN
926  nbtrisact = nbtrisact + 1
927 
928  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
929  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
930  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
931 
932  ppatch%bTri2v(1,nbtrisact) = v1g
933  ppatch%bTri2v(2,nbtrisact) = v2g
934  ppatch%bTri2v(3,nbtrisact) = v3g
935 
936  ifl2 = nbtrisact
937 
938  pgrid%pbf2sbfCSR(offs+ifl2) = ifl
939  ELSE
940  nbquadsact = nbquadsact + 1
941 
942  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
943  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
944  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
945  v4g = ppatchserial%bv(ppatchserial%bf2v(4,ifl))
946 
947  ppatch%bQuad2v(1,nbquadsact) = v1g
948  ppatch%bQuad2v(2,nbquadsact) = v2g
949  ppatch%bQuad2v(3,nbquadsact) = v3g
950  ppatch%bQuad2v(4,nbquadsact) = v4g
951 
952  ifl2 = ppatch%nBTrisTot + nbquadsact
953 
954  pgrid%pbf2sbfCSR(offs + ifl2) = ifl
955  END IF ! pPatchSerial
956  ELSE ! Virtual-boundary face
957  IF ( ppatchserial%bf2v(4,ifl) == vert_none ) THEN
958  nbtrisvir = nbtrisvir + 1
959 
960  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
961  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
962  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
963 
964  ppatch%bTri2v(1,ppatch%nBTris+nbtrisvir) = v1g
965  ppatch%bTri2v(2,ppatch%nBTris+nbtrisvir) = v2g
966  ppatch%bTri2v(3,ppatch%nBTris+nbtrisvir) = v3g
967 
968  ifl2 = ppatch%nBTris + nbtrisvir
969 
970  pgrid%pbf2sbfCSR(offs+ifl2) = ifl
971  ELSE
972  nbquadsvir = nbquadsvir + 1
973 
974  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
975  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
976  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
977  v4g = ppatchserial%bv(ppatchserial%bf2v(4,ifl))
978 
979  ppatch%bQuad2v(1,ppatch%nBQuads+nbquadsvir) = v1g
980  ppatch%bQuad2v(2,ppatch%nBQuads+nbquadsvir) = v2g
981  ppatch%bQuad2v(3,ppatch%nBQuads+nbquadsvir) = v3g
982  ppatch%bQuad2v(4,ppatch%nBQuads+nbquadsvir) = v4g
983 
984  ifl2 = ppatch%nBTrisTot + ppatch%nBQuads + nbquadsvir
985 
986  pgrid%pbf2sbfCSR(offs+ifl2) = ifl
987  END IF ! pPatchSerial
988  END IF ! icg2
989 
990 ! ------- Cell does not exist although it should -------------------------------
991 
992  ELSE
993  IF ( ireg == pregion%iRegionGlobal ) THEN
994  CALL errorstop(global,err_cell_not_found,__line__)
995  END IF ! iReg
996  END IF ! iLoc
997  END DO ! ifl
998 
999 ! ==============================================================================
1000 ! Virtual patch
1001 ! ==============================================================================
1002 
1003  ELSE
1004 
1005 ! ------------------------------------------------------------------------------
1006 ! Allocate and build sorted bf2c list along with key so that can get
1007 ! local boundary face index on serial grid for given global cell index
1008 ! ------------------------------------------------------------------------------
1009 
1010  ALLOCATE(ppatchserial%bf2cSorted(ppatchserial%nBFacesTot), &
1011  stat=errorflag)
1012  global%error = errorflag
1013  IF ( global%error /= err_none ) THEN
1014  CALL errorstop(global,err_allocate,__line__, &
1015  'pPatchSerial%bf2cSorted')
1016  END IF ! global%error
1017 
1018  ALLOCATE(ppatchserial%bf2cSortedKeys(ppatchserial%nBFacesTot), &
1019  stat=errorflag)
1020  global%error = errorflag
1021  IF ( global%error /= err_none ) THEN
1022  CALL errorstop(global,err_allocate,__line__, &
1023  'pPatchSerial%bf2cSortedKeys')
1024  END IF ! global%error
1025 
1026  DO ifl = 1,ppatchserial%nBFacesTot
1027  ppatchserial%bf2cSorted(ifl) = ppatchserial%bf2c(ifl)
1028  ppatchserial%bf2cSortedKeys(ifl) = ifl
1029  END DO ! ifl
1030 
1031  CALL quicksortintegerinteger(ppatchserial%bf2cSorted, &
1032  ppatchserial%bf2cSortedKeys, &
1033  ppatchserial%nBFacesTot)
1034 
1035 ! ------------------------------------------------------------------------------
1036 ! Loop over cells in partitioned region. Every single one of them must be
1037 ! on virtual patch.
1038 ! ------------------------------------------------------------------------------
1039 
1040  DO icg = 1,pgrid%nCellsTot
1041  icg2 = pgrid%pc2sc(icg)
1042 
1043 ! ------- Check on sorted bf2c list --------------------------------------------
1044 
1045  IF ( ppatchserial%bf2cSorted(icg2) == icg2 ) THEN
1046  ifl = ppatchserial%bf2cSortedKeys(icg2)
1047 
1048  ict = pgrid%cellGlob2Loc(1,icg)
1049  icl = pgrid%cellGlob2Loc(2,icg)
1050 
1051  SELECT CASE ( ict )
1052  CASE ( cell_type_hex )
1053  IF ( icl <= pgrid%nHexs ) THEN ! Actual quad boundary face
1054  nbquadsact = nbquadsact + 1
1055 
1056  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
1057  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
1058  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
1059  v4g = ppatchserial%bv(ppatchserial%bf2v(4,ifl))
1060 
1061  ppatch%bQuad2v(1,nbquadsact) = v1g
1062  ppatch%bQuad2v(2,nbquadsact) = v2g
1063  ppatch%bQuad2v(3,nbquadsact) = v3g
1064  ppatch%bQuad2v(4,nbquadsact) = v4g
1065 
1066  ifl2 = ppatch%nBTrisTot + nbquadsact
1067 
1068  pgrid%pbf2sbfCSR(offs + ifl2) = ifl
1069  ELSE ! Virtual quad boundary face
1070  nbquadsvir = nbquadsvir + 1
1071 
1072  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
1073  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
1074  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
1075  v4g = ppatchserial%bv(ppatchserial%bf2v(4,ifl))
1076 
1077  ppatch%bQuad2v(1,ppatch%nBQuads+nbquadsvir) = v1g
1078  ppatch%bQuad2v(2,ppatch%nBQuads+nbquadsvir) = v2g
1079  ppatch%bQuad2v(3,ppatch%nBQuads+nbquadsvir) = v3g
1080  ppatch%bQuad2v(4,ppatch%nBQuads+nbquadsvir) = v4g
1081 
1082  ifl2 = ppatch%nBTrisTot + ppatch%nBQuads + nbquadsvir
1083 
1084  pgrid%pbf2sbfCSR(offs+ifl2) = ifl
1085  END IF ! icl
1086  CASE ( cell_type_pri )
1087  IF ( icl <= pgrid%nPris ) THEN ! Actual tri boundary face
1088  nbtrisact = nbtrisact + 1
1089 
1090  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
1091  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
1092  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
1093 
1094  ppatch%bTri2v(1,nbtrisact) = v1g
1095  ppatch%bTri2v(2,nbtrisact) = v2g
1096  ppatch%bTri2v(3,nbtrisact) = v3g
1097 
1098  ifl2 = nbtrisact
1099 
1100  pgrid%pbf2sbfCSR(offs+ifl2) = ifl
1101  ELSE ! Virtual tri boundary face
1102  nbtrisvir = nbtrisvir + 1
1103 
1104  v1g = ppatchserial%bv(ppatchserial%bf2v(1,ifl))
1105  v2g = ppatchserial%bv(ppatchserial%bf2v(2,ifl))
1106  v3g = ppatchserial%bv(ppatchserial%bf2v(3,ifl))
1107 
1108  ppatch%bTri2v(1,ppatch%nBTris+nbtrisvir) = v1g
1109  ppatch%bTri2v(2,ppatch%nBTris+nbtrisvir) = v2g
1110  ppatch%bTri2v(3,ppatch%nBTris+nbtrisvir) = v3g
1111 
1112  ifl2 = ppatch%nBTris + nbtrisvir
1113 
1114  pgrid%pbf2sbfCSR(offs+ifl2) = ifl
1115  END IF ! icl
1116  CASE default
1117  CALL errorstop(global,err_reached_default,__line__)
1118  END SELECT ! ict
1119 
1120 ! ------- Getting here means that cell is not adjacent to virtual patch --------
1121 
1122  ELSE
1123  CALL errorstop(global,err_bf2csorted_invalid,__line__)
1124  END IF ! pPatchSerial%bf2cSorted
1125  END DO ! icg
1126 
1127  DEALLOCATE(ppatchserial%bf2cSorted,stat=errorflag)
1128  global%error = errorflag
1129  IF ( global%error /= err_none ) THEN
1130  CALL errorstop(global,err_deallocate,__line__, &
1131  'pPatchSerial%bf2cSorted')
1132  END IF ! global%error
1133 
1134  DEALLOCATE(ppatchserial%bf2cSortedKeys,stat=errorflag)
1135  global%error = errorflag
1136  IF ( global%error /= err_none ) THEN
1137  CALL errorstop(global,err_deallocate,__line__, &
1138  'pPatchSerial%bf2cSortedKeys')
1139  END IF ! global%error
1140  END IF ! pPatchSerial%bcType
1141  END DO ! iPatch
1142 
1143 ! ******************************************************************************
1144 ! End
1145 ! ******************************************************************************
1146 
1147  IF ( global%verbLevel > verbose_none ) THEN
1148  WRITE(stdout,'(A,1X,A)') solver_name,'Building patch lists done.'
1149  END IF ! global%verbLevel
1150 
1151  CALL deregisterfunction(global)
1152 
1153  END SUBROUTINE rflu_part_buildpatchlists
1154 
1155 
1156 
1157 
1158 
1159 
1160 
1161 ! ******************************************************************************
1162 !
1163 ! Purpose: Build region-to-cell map.
1164 !
1165 ! Description: None.
1166 !
1167 ! Input:
1168 ! pRegion Pointer to region
1169 !
1170 ! Output: None.
1171 !
1172 ! Notes: None.
1173 !
1174 ! ******************************************************************************
1175 
1176  SUBROUTINE rflu_part_buildreg2cellmap(pRegion)
1177 
1178  IMPLICIT NONE
1179 
1180 ! ******************************************************************************
1181 ! Declarations and definitions
1182 ! ******************************************************************************
1183 
1184 ! ==============================================================================
1185 ! Arguments
1186 ! ==============================================================================
1187 
1188  TYPE(t_region), POINTER :: pregion
1189 
1190 ! ==============================================================================
1191 ! Locals
1192 ! ==============================================================================
1193 
1194  INTEGER :: errorflag,icg,ireg
1195  TYPE(t_grid), POINTER :: pgrid
1196  TYPE(t_global), POINTER :: global
1197 
1198 ! ******************************************************************************
1199 ! Start
1200 ! ******************************************************************************
1201 
1202  global => pregion%global
1203 
1204  CALL registerfunction(global,'RFLU_PART_BuildReg2CellMap',&
1205  'RFLU_ModPartitionRegion.F90')
1206 
1207  IF ( global%verbLevel > verbose_none ) THEN
1208  WRITE(stdout,'(A,1X,A)') solver_name,'Building region-to-cell map...'
1209  END IF ! global%verbLevel
1210 
1211  IF ( global%verbLevel > verbose_low ) THEN
1212  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1213  pregion%iRegionGlobal
1214  END IF ! global%verbLevel
1215 
1216 ! ******************************************************************************
1217 ! Set pointers
1218 ! ******************************************************************************
1219 
1220  pgrid => pregion%grid
1221 
1222 ! ******************************************************************************
1223 ! Count cells in each region and set up info array
1224 ! ******************************************************************************
1225 
1226  DO icg = 1,pgrid%nCellsTot
1227  ireg = pgrid%sc2r(icg)
1228 
1229  pgrid%r2pcCSRInfo(ireg) = pgrid%r2pcCSRInfo(ireg) + 1
1230  END DO ! icg
1231 
1232  pgrid%r2pcCSRInfo(0) = pgrid%r2pcCSRInfo(0) + 1
1233 
1234  DO ireg = 1,global%nRegionsLocal
1235  pgrid%r2pcCSRInfo(ireg) = pgrid%r2pcCSRInfo(ireg ) &
1236  + pgrid%r2pcCSRInfo(ireg-1)
1237  END DO ! iReg
1238 
1239 ! ******************************************************************************
1240 ! Enter cell into mapping array. NOTE loop backwards because stepping back in
1241 ! r2pcCSRInfo array (from last position to first position); that way get same
1242 ! ordering in cell indices as on serial region.
1243 ! ******************************************************************************
1244 
1245  DO icg = pgrid%nCellsTot,1,-1
1246  ireg = pgrid%sc2r(icg)
1247 
1248  pgrid%r2pcCSRInfo(ireg) = pgrid%r2pcCSRInfo(ireg) - 1
1249 
1250  pgrid%r2pcCSR(pgrid%r2pcCSRInfo(ireg)) = icg
1251  END DO ! icg
1252 
1253 ! ******************************************************************************
1254 ! End
1255 ! ******************************************************************************
1256 
1257  IF ( global%verbLevel > verbose_none ) THEN
1258  WRITE(stdout,'(A,1X,A)') solver_name,'Building region-to-cell map done.'
1259  END IF ! global%verbLevel
1260 
1261  CALL deregisterfunction(global)
1262 
1263  END SUBROUTINE rflu_part_buildreg2cellmap
1264 
1265 
1266 
1267 
1268 
1269 
1270 
1271 
1272 
1273 ! ******************************************************************************
1274 !
1275 ! Purpose: Build vertex data.
1276 !
1277 ! Description: None.
1278 !
1279 ! Input:
1280 ! levels Level data structure
1281 !
1282 ! Output: None.
1283 !
1284 ! Notes: None.
1285 !
1286 ! ******************************************************************************
1287 
1288  SUBROUTINE rflu_part_buildvertexdata(pRegion,pRegionSerial)
1289 
1290  IMPLICIT NONE
1291 
1292 ! ******************************************************************************
1293 ! Declarations and definitions
1294 ! ******************************************************************************
1295 
1296 ! ==============================================================================
1297 ! Arguments
1298 ! ==============================================================================
1299 
1300  TYPE(t_region), POINTER :: pregion,pregionserial
1301 
1302 ! ==============================================================================
1303 ! Locals
1304 ! ==============================================================================
1305 
1306  INTEGER :: errorflag,ivg,ivg2
1307  TYPE(t_global), POINTER :: global
1308  TYPE(t_grid), POINTER :: pgrid,pgridserial
1309 
1310 ! ******************************************************************************
1311 ! Start
1312 ! ******************************************************************************
1313 
1314  global => pregion%global
1315 
1316  CALL registerfunction(global,'RFLU_PART_BuildVertexData',&
1317  'RFLU_ModPartitionRegion.F90')
1318 
1319  IF ( global%verbLevel > verbose_none ) THEN
1320  WRITE(stdout,'(A,1X,A)') solver_name,'Building vertex data...'
1321  END IF ! global%verbLevel
1322 
1323  IF ( global%verbLevel > verbose_low ) THEN
1324  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1325  pregion%iRegionGlobal
1326  END IF ! global%verbLevel
1327 
1328 ! ******************************************************************************
1329 ! Set pointers
1330 ! ******************************************************************************
1331 
1332  pgrid => pregion%grid
1333  pgridserial => pregionserial%grid
1334 
1335 ! ******************************************************************************
1336 ! Allocate memory for cell mapping
1337 ! ******************************************************************************
1338 
1339  ALLOCATE(pgrid%xyz(xcoord:zcoord,pgrid%nVertTot),stat=errorflag)
1340  global%error = errorflag
1341  IF ( global%error /= err_none ) THEN
1342  CALL errorstop(global,err_allocate,__line__,'pGrid%xyz')
1343  END IF ! global%error
1344 
1345  DO ivg = 1,pgrid%nVertTot
1346  ivg2 = pgrid%pv2sv(ivg)
1347 
1348  pgrid%xyz(xcoord,ivg) = pgridserial%xyz(xcoord,ivg2)
1349  pgrid%xyz(ycoord,ivg) = pgridserial%xyz(ycoord,ivg2)
1350  pgrid%xyz(zcoord,ivg) = pgridserial%xyz(zcoord,ivg2)
1351  END DO ! ivg
1352 
1353 ! ******************************************************************************
1354 ! End
1355 ! ******************************************************************************
1356 
1357  IF ( global%verbLevel > verbose_none ) THEN
1358  WRITE(stdout,'(A,1X,A)') solver_name,'Building vertex data done.'
1359  END IF ! global%verbLevel
1360 
1361  CALL deregisterfunction(global)
1362 
1363  END SUBROUTINE rflu_part_buildvertexdata
1364 
1365 
1366 
1367 
1368 
1369 
1370 
1371 ! ******************************************************************************
1372 !
1373 ! Purpose: Build vertex lists.
1374 !
1375 ! Description: None.
1376 !
1377 ! Input:
1378 ! pRegion Pointer to region
1379 ! pRegionSerial Pointer to serial region
1380 !
1381 ! Output: None.
1382 !
1383 ! Notes: None.
1384 !
1385 ! ******************************************************************************
1386 
1387  SUBROUTINE rflu_part_buildvertexlists(pRegion,pRegionSerial)
1388 
1389  USE modsortsearch
1390 
1391  USE rflu_modhashtable
1392  USE rflu_modrenumberlist, ONLY: rflu_renumberlist2
1393  USE rflu_modrenumberings, ONLY: rflu_rnmb_createpv2svmap
1394 
1395  IMPLICIT NONE
1396 
1397 ! ******************************************************************************
1398 ! Declarations and definitions
1399 ! ******************************************************************************
1400 
1401 ! ==============================================================================
1402 ! Arguments
1403 ! ==============================================================================
1404 
1405  TYPE(t_region), POINTER :: pregion,pregionserial
1406 
1407 ! ==============================================================================
1408 ! Locals
1409 ! ==============================================================================
1410 
1411  INTEGER :: errorflag,icl,iloc,ivg,ivgindx,ivgstat,ivl,key,nvertact,nvertint, &
1412  nvertvir
1413  INTEGER, DIMENSION(:), ALLOCATABLE :: indx,templist
1414  TYPE(t_grid), POINTER :: pgrid,pgridserial
1415  TYPE(t_global), POINTER :: global
1416 
1417 ! ******************************************************************************
1418 ! Start
1419 ! ******************************************************************************
1420 
1421  global => pregion%global
1422 
1423  CALL registerfunction(global,'RFLU_PART_BuildVertexLists',&
1424  'RFLU_ModPartitionRegion.F90')
1425 
1426  IF ( global%verbLevel > verbose_none ) THEN
1427  WRITE(stdout,'(A,1X,A)') solver_name,'Building vertex lists...'
1428  END IF ! global%verbLevel
1429 
1430  IF ( global%verbLevel > verbose_low ) THEN
1431  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1432  pregion%iRegionGlobal
1433  END IF ! global%verbLevel
1434 
1435 ! ******************************************************************************
1436 ! Set pointers
1437 ! ******************************************************************************
1438 
1439  pgrid => pregion%grid
1440  pgridserial => pregionserial%grid
1441 
1442 ! ******************************************************************************
1443 ! Estimate number of vertices, create hash table, and allocate memory for
1444 ! mapping from vertices in this partition to serial partition
1445 ! ******************************************************************************
1446 
1447  pgrid%nVert = 0
1448  pgrid%nVertTot = 0
1449 
1450 ! TO DO
1451 ! Must find improved estimate of maximum number of vertices
1452 ! END TO DO
1453  pgrid%nVertMax = 1.5_rfreal*8*pgrid%nCellsTot
1454 
1455  CALL rflu_createhashtable(global,pgrid%nVertMax)
1456 
1457  ALLOCATE(indx(hashtablesize),stat=errorflag)
1458  global%error = errorflag
1459  IF ( global%error /= err_none ) THEN
1460  CALL errorstop(global,err_allocate,__line__,'indx')
1461  END IF ! global%error
1462 
1463  CALL rflu_rnmb_createpv2svmap(pregion)
1464 
1465  ALLOCATE(pgrid%vertKind(pgrid%nVertMax),stat=errorflag)
1466  global%error = errorflag
1467  IF ( global%error /= err_none ) THEN
1468  CALL errorstop(global,err_allocate,__line__,'pGrid%vertKind')
1469  END IF ! global%error
1470 
1471  DO ivg = 1,pgrid%nVertMax
1472  pgrid%vertKind(ivg) = vert_none
1473  END DO ! ivg
1474 
1475 ! ******************************************************************************
1476 ! Determine number of vertices by constructing hash table of global vertex
1477 ! indices. After sorting, this list will be used as the key for renumbering
1478 ! the vertices in this partition.
1479 ! ******************************************************************************
1480 
1481 ! ==============================================================================
1482 ! Actual cells
1483 ! ==============================================================================
1484 
1485  DO icl = 1,pgrid%nTets
1486  DO ivl = 1,4
1487  CALL rflu_hashbuildkey(pgrid%tet2v(ivl,icl:icl),1,key)
1488  CALL rflu_hashvertexfancy(global,key,pgrid%tet2v(ivl,icl), &
1489  pgrid%nVertTot,pgrid%pv2sv, &
1490  indx,ivgstat,ivgindx)
1491  END DO ! ivl
1492  END DO ! icl
1493 
1494  DO icl = 1,pgrid%nHexs
1495  DO ivl = 1,8
1496  CALL rflu_hashbuildkey(pgrid%hex2v(ivl,icl:icl),1,key)
1497  CALL rflu_hashvertexfancy(global,key,pgrid%hex2v(ivl,icl), &
1498  pgrid%nVertTot,pgrid%pv2sv, &
1499  indx,ivgstat,ivgindx)
1500  END DO ! ivl
1501  END DO ! icl
1502 
1503  DO icl = 1,pgrid%nPris
1504  DO ivl = 1,6
1505  CALL rflu_hashbuildkey(pgrid%pri2v(ivl,icl:icl),1,key)
1506  CALL rflu_hashvertexfancy(global,key,pgrid%pri2v(ivl,icl), &
1507  pgrid%nVertTot,pgrid%pv2sv, &
1508  indx,ivgstat,ivgindx)
1509  END DO ! ivl
1510  END DO ! icl
1511 
1512  DO icl = 1,pgrid%nPyrs
1513  DO ivl = 1,5
1514  CALL rflu_hashbuildkey(pgrid%pyr2v(ivl,icl:icl),1,key)
1515  CALL rflu_hashvertexfancy(global,key,pgrid%pyr2v(ivl,icl), &
1516  pgrid%nVertTot,pgrid%pv2sv, &
1517  indx,ivgstat,ivgindx)
1518  END DO ! ivl
1519  END DO ! icl
1520 
1521  DO ivg = 1,pgrid%nVertTot
1522  pgrid%vertKind(ivg) = vert_kind_a
1523  END DO ! ivg
1524 
1525 ! ==============================================================================
1526 ! Virtual cells
1527 ! ==============================================================================
1528 
1529  DO icl = pgrid%nTets+1,pgrid%nTetsTot
1530  DO ivl = 1,4
1531  CALL rflu_hashbuildkey(pgrid%tet2v(ivl,icl:icl),1,key)
1532  CALL rflu_hashvertexfancy(global,key,pgrid%tet2v(ivl,icl), &
1533  pgrid%nVertTot,pgrid%pv2sv, &
1534  indx,ivgstat,ivgindx)
1535 
1536  IF ( ivgstat == hashtable_entrystatus_new ) THEN
1537  pgrid%vertKind(pgrid%nVertTot) = vert_kind_v
1538  ELSE
1539  IF ( pgrid%vertKind(ivgindx) == vert_kind_a ) THEN
1540  pgrid%vertKind(ivgindx) = vert_kind_av
1541  END IF ! pGrid%vertKind
1542  END IF ! ivgStat
1543  END DO ! ivl
1544  END DO ! icl
1545 
1546  DO icl = pgrid%nHexs+1,pgrid%nHexsTot
1547  DO ivl = 1,8
1548  CALL rflu_hashbuildkey(pgrid%hex2v(ivl,icl:icl),1,key)
1549  CALL rflu_hashvertexfancy(global,key,pgrid%hex2v(ivl,icl), &
1550  pgrid%nVertTot,pgrid%pv2sv, &
1551  indx,ivgstat,ivgindx)
1552 
1553  IF ( ivgstat == hashtable_entrystatus_new ) THEN
1554  pgrid%vertKind(pgrid%nVertTot) = vert_kind_v
1555  ELSE
1556  IF ( pgrid%vertKind(ivgindx) == vert_kind_a ) THEN
1557  pgrid%vertKind(ivgindx) = vert_kind_av
1558  END IF ! pGrid%vertKind
1559  END IF ! ivgStat
1560  END DO ! ivl
1561  END DO ! icl
1562 
1563  DO icl = pgrid%nPris+1,pgrid%nPrisTot
1564  DO ivl = 1,6
1565  CALL rflu_hashbuildkey(pgrid%pri2v(ivl,icl:icl),1,key)
1566  CALL rflu_hashvertexfancy(global,key,pgrid%pri2v(ivl,icl), &
1567  pgrid%nVertTot,pgrid%pv2sv, &
1568  indx,ivgstat,ivgindx)
1569 
1570  IF ( ivgstat == hashtable_entrystatus_new ) THEN
1571  pgrid%vertKind(pgrid%nVertTot) = vert_kind_v
1572  ELSE
1573  IF ( pgrid%vertKind(ivgindx) == vert_kind_a ) THEN
1574  pgrid%vertKind(ivgindx) = vert_kind_av
1575  END IF ! pGrid%vertKind
1576  END IF ! ivgStat
1577  END DO ! ivl
1578  END DO ! icl
1579 
1580  DO icl = pgrid%nPyrs+1,pgrid%nPyrsTot
1581  DO ivl = 1,5
1582  CALL rflu_hashbuildkey(pgrid%pyr2v(ivl,icl:icl),1,key)
1583  CALL rflu_hashvertexfancy(global,key,pgrid%pyr2v(ivl,icl), &
1584  pgrid%nVertTot,pgrid%pv2sv, &
1585  indx,ivgstat,ivgindx)
1586 
1587  IF ( ivgstat == hashtable_entrystatus_new ) THEN
1588  pgrid%vertKind(pgrid%nVertTot) = vert_kind_v
1589  ELSE
1590  IF ( pgrid%vertKind(ivgindx) == vert_kind_a ) THEN
1591  pgrid%vertKind(ivgindx) = vert_kind_av
1592  END IF ! pGrid%vertKind
1593  END IF ! ivgStat
1594  END DO ! ivl
1595  END DO ! icl
1596 
1597 ! ******************************************************************************
1598 ! Destroy hash table
1599 ! ******************************************************************************
1600 
1601  CALL rflu_destroyhashtable(global)
1602 
1603  DEALLOCATE(indx,stat=errorflag)
1604  global%error = errorflag
1605  IF ( global%error /= err_none ) THEN
1606  CALL errorstop(global,err_deallocate,__line__,'indx')
1607  END IF ! global%error
1608 
1609 ! ==============================================================================
1610 ! Count number of vertices. NOTE at this stage, pGrid%nVert only holds the
1611 ! number of vertices which are EXCLUSIVELY in the region, and does NOT hold
1612 ! the number of vertices on the interface, as it usually does.
1613 ! ==============================================================================
1614 
1615  pgrid%nVert = 0
1616  pgrid%nVertInt = 0
1617 
1618  DO ivg = 1,pgrid%nVertTot
1619  SELECT CASE ( pgrid%vertKind(ivg) )
1620  CASE ( vert_kind_a )
1621  pgrid%nVert = pgrid%nVert + 1
1622  CASE ( vert_kind_v )
1623 
1624  CASE ( vert_kind_av )
1625  pgrid%nVertInt = pgrid%nVertInt + 1
1626  CASE default
1627  CALL errorstop(global,err_reached_default,__line__)
1628  END SELECT ! pGrid%vertKind
1629  END DO ! ivg
1630 
1631 ! ******************************************************************************
1632 ! Copy list and reorder so have actual vertices at the beginning, followed by
1633 ! actual-virtual vertices, followed by virtual vertices.
1634 ! ******************************************************************************
1635 
1636  ALLOCATE(templist(pgrid%nVertTot),stat=errorflag)
1637  global%error = errorflag
1638  IF ( global%error /= err_none ) THEN
1639  CALL errorstop(global,err_allocate,__line__,'tempList')
1640  END IF ! global%error
1641 
1642  nvertact = 0
1643  nvertint = 0
1644  nvertvir = 0
1645 
1646  DO ivg = 1,pgrid%nVertTot
1647  SELECT CASE ( pgrid%vertKind(ivg) )
1648  CASE ( vert_kind_a )
1649  nvertact = nvertact + 1
1650  ivl = nvertact
1651  templist(nvertact) = pgrid%pv2sv(ivg)
1652  CASE ( vert_kind_v )
1653  nvertvir = nvertvir + 1
1654  ivl = pgrid%nVert + pgrid%nVertInt + nvertvir
1655  templist(ivl) = pgrid%pv2sv(ivg)
1656  CASE ( vert_kind_av )
1657  nvertint = nvertint + 1
1658  ivl = pgrid%nVert + nvertint
1659  templist(ivl) = pgrid%pv2sv(ivg)
1660  CASE default
1661  CALL errorstop(global,err_reached_default,__line__)
1662  END SELECT ! pGrid%vertKind
1663  END DO ! ivg
1664 
1665 ! ******************************************************************************
1666 ! Copy sorted list to give mapping from partitioned vertex to corresponding
1667 ! serial vertex
1668 ! ******************************************************************************
1669 
1670  DO ivg = 1,pgrid%nVertTot
1671  pgrid%pv2sv(ivg) = templist(ivg)
1672  END DO ! ivg
1673 
1674  DEALLOCATE(templist,stat=errorflag)
1675  global%error = errorflag
1676  IF ( global%error /= err_none ) THEN
1677  CALL errorstop(global,err_deallocate,__line__,'tempList')
1678  END IF ! global%error
1679 
1680 ! ******************************************************************************
1681 ! Set number of actual vertices
1682 ! ******************************************************************************
1683 
1684  pgrid%nVert = pgrid%nVert + pgrid%nVertInt
1685 
1686 ! ******************************************************************************
1687 ! End
1688 ! ******************************************************************************
1689 
1690  IF ( global%verbLevel > verbose_none ) THEN
1691  WRITE(stdout,'(A,1X,A)') solver_name,'Building vertex lists done.'
1692  END IF ! global%verbLevel
1693 
1694  CALL deregisterfunction(global)
1695 
1696  END SUBROUTINE rflu_part_buildvertexlists
1697 
1698 
1699 
1700 
1701 
1702 
1703 
1704 
1705 
1706 ! ******************************************************************************
1707 !
1708 ! Purpose: Create cell lists.
1709 !
1710 ! Description: None.
1711 !
1712 ! Input:
1713 ! pRegion Pointer to region
1714 ! pRegionSerial Pointer to serial region
1715 !
1716 ! Output: None.
1717 !
1718 ! Notes: None.
1719 !
1720 ! ******************************************************************************
1721 
1722  SUBROUTINE rflu_part_createcelllists(pRegion,pRegionSerial)
1723 
1724  IMPLICIT NONE
1725 
1726 ! ******************************************************************************
1727 ! Declarations and definitions
1728 ! ******************************************************************************
1729 
1730 ! ==============================================================================
1731 ! Arguments
1732 ! ==============================================================================
1733 
1734  TYPE(t_region), POINTER :: pregion,pregionserial
1735 
1736 ! ==============================================================================
1737 ! Locals
1738 ! ==============================================================================
1739 
1740  INTEGER :: errorflag,i,ibeg,icg,icg2,icl,icl2,ict,iend,ireg
1741  TYPE(t_grid), POINTER :: pgrid,pgridserial
1742  TYPE(t_global), POINTER :: global
1743 
1744 ! ******************************************************************************
1745 ! Start
1746 ! ******************************************************************************
1747 
1748  global => pregion%global
1749 
1750  CALL registerfunction(global,'RFLU_PART_CreateCellLists',&
1751  'RFLU_ModPartitionRegion.F90')
1752 
1753  IF ( global%verbLevel > verbose_none ) THEN
1754  WRITE(stdout,'(A,1X,A)') solver_name,'Creating cell lists...'
1755  END IF ! global%verbLevel
1756 
1757  IF ( global%verbLevel > verbose_low ) THEN
1758  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1759  pregion%iRegionGlobal
1760  END IF ! global%verbLevel
1761 
1762 ! ******************************************************************************
1763 ! Set pointers
1764 ! ******************************************************************************
1765 
1766  pgrid => pregion%grid
1767  pgridserial => pregionserial%grid
1768 
1769 ! ******************************************************************************
1770 ! Determine number of cells for each type
1771 ! ******************************************************************************
1772 
1773  ireg = pregion%iRegionGlobal
1774  ibeg = pgridserial%r2pcCSRInfo(ireg)
1775 
1776  IF ( ireg /= global%nRegionsLocal ) THEN
1777  iend = pgridserial%r2pcCSRInfo(ireg+1)-1
1778  ELSE
1779  iend = pgridserial%nCellsTot
1780  END IF ! iReg
1781 
1782  DO i = ibeg,iend
1783  icg = pgridserial%r2pcCSR(i)
1784 
1785  ict = pgridserial%cellGlob2Loc(1,icg)
1786  icl = pgridserial%cellGlob2Loc(2,icg)
1787 
1788  SELECT CASE ( ict )
1789  CASE ( cell_type_tet )
1790  IF ( icl <= pgridserial%nTets ) THEN
1791  pgrid%nTets = pgrid%nTets + 1
1792  pgrid%nTetsTot = pgrid%nTetsTot + 1
1793  ELSE
1794  pgrid%nTetsTot = pgrid%nTetsTot + 1
1795  END IF ! icl
1796  CASE ( cell_type_hex )
1797  IF ( icl <= pgridserial%nHexs ) THEN
1798  pgrid%nHexs = pgrid%nHexs + 1
1799  pgrid%nHexsTot = pgrid%nHexsTot + 1
1800  ELSE
1801  pgrid%nHexsTot = pgrid%nHexsTot + 1
1802  END IF ! icl
1803  CASE ( cell_type_pri )
1804  IF ( icl <= pgridserial%nPris ) THEN
1805  pgrid%nPris = pgrid%nPris + 1
1806  pgrid%nPrisTot = pgrid%nPrisTot + 1
1807  ELSE
1808  pgrid%nPrisTot = pgrid%nPrisTot + 1
1809  END IF ! icl
1810  CASE ( cell_type_pyr )
1811  IF ( icl <= pgridserial%nPyrs ) THEN
1812  pgrid%nPyrs = pgrid%nPyrs + 1
1813  pgrid%nPyrsTot = pgrid%nPyrsTot + 1
1814  ELSE
1815  pgrid%nPyrsTot = pgrid%nPyrsTot + 1
1816  END IF ! icl
1817  CASE default
1818  CALL errorstop(global,err_reached_default,__line__)
1819  END SELECT ! ict
1820  END DO ! i
1821 
1822 ! ******************************************************************************
1823 ! Set maximum dimensions. NOTE must be generous in setting maximum dimensions
1824 ! because have not yet added virtual cells. NOTE also that a region may not
1825 ! contain any actual cells of a given type, but may contain virtual cells of
1826 ! that type.
1827 ! ******************************************************************************
1828 
1829  pgrid%nTetsMax = 4*pgrid%nTetsTot
1830  pgrid%nHexsMax = 4*pgrid%nHexsTot
1831  pgrid%nPrisMax = 4*pgrid%nPrisTot
1832  pgrid%nPyrsMax = 4*pgrid%nPyrsTot
1833 
1834  IF ( pgrid%nTetsMax < 100 ) THEN
1835  pgrid%nTetsMax = 10*pgridserial%nTetsTot/global%nRegions
1836  END IF ! pGrid%nTetsMax
1837 
1838  IF ( pgrid%nHexsMax < 100 ) THEN
1839  pgrid%nHexsMax = 10*pgridserial%nHexsTot/global%nRegions
1840  END IF ! pGrid%nHexsMax
1841 
1842  IF ( pgrid%nPrisMax < 100 ) THEN
1843  pgrid%nPrisMax = 10*pgridserial%nPrisTot/global%nRegions
1844  END IF ! pGrid%nPrisMax
1845 
1846  IF ( pgrid%nPyrsMax < 100 ) THEN
1847  pgrid%nPyrsMax = 10*pgridserial%nPyrsTot/global%nRegions
1848  END IF ! pGrid%nPyrsMax
1849 
1850 ! ******************************************************************************
1851 ! Set overall dimensions and write statistics
1852 ! ******************************************************************************
1853 
1854  pgrid%nCells = pgrid%nTets + pgrid%nHexs &
1855  + pgrid%nPris + pgrid%nPyrs
1856  pgrid%nCellsTot = pgrid%nTetsTot + pgrid%nHexsTot &
1857  + pgrid%nPrisTot + pgrid%nPyrsTot
1858  pgrid%nCellsMax = pgrid%nTetsMax + pgrid%nHexsMax &
1859  + pgrid%nPrisMax + pgrid%nPyrsMax
1860 
1861  IF ( global%verbLevel > verbose_none ) THEN
1862  WRITE(stdout,'(A,3X,A)') solver_name,'Cell statistics:'
1863  WRITE(stdout,'(A,5X,A,3X,3(1X,I8))') solver_name,'Cells: ', &
1864  pgrid%nCells, &
1865  pgrid%nCellsTot, &
1866  pgrid%nCellsMax
1867  WRITE(stdout,'(A,7X,A,1X,3(1X,I8))') solver_name,'Tetrahedra:', &
1868  pgrid%nTets, &
1869  pgrid%nTetsTot, &
1870  pgrid%nTetsMax
1871  WRITE(stdout,'(A,7X,A,1X,3(1X,I8))') solver_name,'Hexahedra: ', &
1872  pgrid%nHexs, &
1873  pgrid%nHexsTot, &
1874  pgrid%nHexsMax
1875  WRITE(stdout,'(A,7X,A,1X,3(1X,I8))') solver_name,'Prisms: ', &
1876  pgrid%nPris, &
1877  pgrid%nPrisTot, &
1878  pgrid%nPrisMax
1879  WRITE(stdout,'(A,7X,A,1X,3(1X,I8))') solver_name,'Pyramids: ', &
1880  pgrid%nPyrs, &
1881  pgrid%nPyrsTot, &
1882  pgrid%nPyrsMax
1883  END IF ! global%verbLevel
1884 
1885 ! ******************************************************************************
1886 ! Allocate memory
1887 ! ******************************************************************************
1888 
1889 ! ==============================================================================
1890 ! Connectivity
1891 ! ==============================================================================
1892 
1893  IF ( pgrid%nTetsMax > 0 ) THEN
1894  ALLOCATE(pgrid%tet2v(4,pgrid%nTetsMax),stat=errorflag)
1895  global%error = errorflag
1896  IF ( global%error /= err_none ) THEN
1897  CALL errorstop(global,err_allocate,__line__,'pGrid%tet2v')
1898  END IF ! global%error
1899  ELSE
1900  nullify(pgrid%tet2v)
1901  END IF ! pGrid%nTetsMax
1902 
1903  IF ( pgrid%nHexsMax > 0 ) THEN
1904  ALLOCATE(pgrid%hex2v(8,pgrid%nHexsMax),stat=errorflag)
1905  global%error = errorflag
1906  IF ( global%error /= err_none ) THEN
1907  CALL errorstop(global,err_allocate,__line__,'pGrid%hex2v')
1908  END IF ! global%error
1909  ELSE
1910  nullify(pgrid%hex2v)
1911  END IF ! pGrid%nHexsMax
1912 
1913  IF ( pgrid%nPrisMax > 0 ) THEN
1914  ALLOCATE(pgrid%pri2v(6,pgrid%nPrisMax),stat=errorflag)
1915  global%error = errorflag
1916  IF ( global%error /= err_none ) THEN
1917  CALL errorstop(global,err_allocate,__line__,'pGrid%pri2v')
1918  END IF ! global%error
1919  ELSE
1920  nullify(pgrid%pri2v)
1921  END IF ! pGrid%nPrisMax
1922 
1923  IF ( pgrid%nPyrsMax > 0 ) THEN
1924  ALLOCATE(pgrid%pyr2v(5,pgrid%nPyrsMax),stat=errorflag)
1925  global%error = errorflag
1926  IF ( global%error /= err_none ) THEN
1927  CALL errorstop(global,err_allocate,__line__,'pGrid%pyr2v')
1928  END IF ! global%error
1929  ELSE
1930  nullify(pgrid%pyr2v)
1931  END IF ! pGrid%nPyrsMax
1932 
1933 ! ******************************************************************************
1934 ! End
1935 ! ******************************************************************************
1936 
1937  IF ( global%verbLevel > verbose_none ) THEN
1938  WRITE(stdout,'(A,1X,A)') solver_name,'Creating cell lists done.'
1939  END IF ! global%verbLevel
1940 
1941  CALL deregisterfunction(global)
1942 
1943  END SUBROUTINE rflu_part_createcelllists
1944 
1945 
1946 
1947 
1948 
1949 
1950 
1951 
1952 ! ******************************************************************************
1953 !
1954 ! Purpose: Create patch list and determine number of patches.
1955 !
1956 ! Description: None.
1957 !
1958 ! Input:
1959 ! pRegion Pointer to region
1960 ! pRegionSerial Pointer to serial region
1961 !
1962 ! Output: None.
1963 !
1964 ! Notes: None.
1965 !
1966 ! ******************************************************************************
1967 
1968  SUBROUTINE rflu_part_createpatchlists(pRegion,pRegionSerial)
1969 
1970  USE modsortsearch
1971 
1972  IMPLICIT NONE
1973 
1974 ! ******************************************************************************
1975 ! Declarations and definitions
1976 ! ******************************************************************************
1977 
1978 ! ==============================================================================
1979 ! Arguments
1980 ! ==============================================================================
1981 
1982  TYPE(t_region), POINTER :: pregion,pregionserial
1983 
1984 ! ==============================================================================
1985 ! Locals
1986 ! ==============================================================================
1987 
1988  INTEGER :: errorflag,icg,icgmax,icgmin,icg2,ifl,iloc,ipatch,ireg
1989  TYPE(t_grid), POINTER :: pgrid,pgridserial
1990  TYPE(t_global), POINTER :: global
1991  TYPE(t_patch), POINTER :: ppatch,ppatchserial
1992 
1993 ! ******************************************************************************
1994 ! Start
1995 ! ******************************************************************************
1996 
1997  global => pregion%global
1998 
1999  CALL registerfunction(global,'RFLU_PART_CreatePatchLists',&
2000  'RFLU_ModPartitionRegion.F90')
2001 
2002  IF ( global%verbLevel > verbose_none ) THEN
2003  WRITE(stdout,'(A,1X,A)') solver_name,'Creating patch lists...'
2004  END IF ! global%verbLevel
2005 
2006  IF ( global%verbLevel > verbose_low ) THEN
2007  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2008  pregion%iRegionGlobal
2009  END IF ! global%verbLevel
2010 
2011 ! ******************************************************************************
2012 ! Set pointers
2013 ! ******************************************************************************
2014 
2015  pgrid => pregion%grid
2016  pgridserial => pregionserial%grid
2017 
2018 ! ******************************************************************************
2019 ! Allocate temporary memory
2020 ! ******************************************************************************
2021 
2022  ALLOCATE(pgrid%patchCounter(2,face_type_tri:face_type_quad, &
2023  pgridserial%nPatches),stat=errorflag)
2024  global%error = errorflag
2025  IF ( global%error /= err_none ) THEN
2026  CALL errorstop(global,err_allocate,__line__,'pGrid%patchCounter')
2027  END IF ! global%error
2028 
2029  DO ipatch = 1,pgridserial%nPatches
2030  pgrid%patchCounter(1,face_type_tri ,ipatch) = 0 ! Initial value important
2031  pgrid%patchCounter(2,face_type_tri ,ipatch) = 0 ! Initial value important
2032  pgrid%patchCounter(1,face_type_quad,ipatch) = 0 ! Initial value important
2033  pgrid%patchCounter(2,face_type_quad,ipatch) = 0 ! Initial value important
2034  END DO ! iPatch
2035 
2036 ! ******************************************************************************
2037 ! Determine number of patches in this region
2038 ! ******************************************************************************
2039 
2040  IF ( global%verbLevel > verbose_low ) THEN
2041  WRITE(stdout,'(A,3X,A)') solver_name,'Determining number of patches...'
2042  END IF ! global%verbLevel
2043 
2044 ! ==============================================================================
2045 ! Count number of faces on serial patch which are in this region. NOTE need
2046 ! to loop over all serial faces because need to capture both actual and
2047 ! virtual faces of given partitioned region. So looping only over faces which
2048 ! are adjacent to cells in a given partitioned region cannot give virtual
2049 ! cells.
2050 ! ==============================================================================
2051 
2052  icgmin = minval(pgrid%sbc2pc(1:1,1:pgrid%nBCellsTot))
2053  icgmax = maxval(pgrid%sbc2pc(1:1,1:pgrid%nBCellsTot))
2054 
2055  DO ipatch = 1,pgridserial%nPatches
2056  ppatchserial => pregionserial%patches(ipatch)
2057 
2058 ! ------------------------------------------------------------------------------
2059 ! For patches which are not virtual, search for cells adjacent to serial
2060 ! boundary faces in partitioned region. NOTE avoid searching on virtual
2061 ! patches because for 2d cases, searching on virtual patches makes this
2062 ! procedure slow (number of virtual faces equals number of cells in serial
2063 ! region; searching both virtual patches actually unnecessary because the
2064 ! two patches are necessarily partitioned exactly the same). NOTE that the
2065 ! distinction between virtual and other patches is NOT necessary for correct
2066 ! running of the code, it only improves performance.
2067 ! ------------------------------------------------------------------------------
2068 
2069  IF ( ppatchserial%bcType /= bc_virtual ) THEN
2070  DO ifl = 1,ppatchserial%nBFacesTot
2071  icg = ppatchserial%bf2c(ifl)
2072  ireg = pgridserial%sc2r(icg)
2073 
2074  IF ( icg >= icgmin .AND. icg <= icgmax ) THEN ! Search
2075  CALL binarysearchinteger(pgrid%sbc2pc(1:1,1:pgrid%nBCellsTot), &
2076  pgrid%nBCellsTot,icg,iloc)
2077  ELSE ! No need to search
2078  iloc = element_not_found
2079  END IF ! icg
2080 
2081  IF ( iloc /= element_not_found ) THEN
2082  icg2 = pgrid%sbc2pc(2,iloc)
2083 
2084  IF ( icg2 <= pgrid%nCells ) THEN
2085  IF ( ppatchserial%bf2v(4,ifl) == vert_none ) THEN
2086  pgrid%patchCounter(1,face_type_tri,ipatch) = &
2087  pgrid%patchCounter(1,face_type_tri,ipatch) + 1
2088  ELSE
2089  pgrid%patchCounter(1,face_type_quad,ipatch) = &
2090  pgrid%patchCounter(1,face_type_quad,ipatch) + 1
2091  END IF ! pPatchSerial
2092  ELSE
2093  IF ( ppatchserial%bf2v(4,ifl) == vert_none ) THEN
2094  pgrid%patchCounter(2,face_type_tri,ipatch) = &
2095  pgrid%patchCounter(2,face_type_tri,ipatch) + 1
2096  ELSE
2097  pgrid%patchCounter(2,face_type_quad,ipatch) = &
2098  pgrid%patchCounter(2,face_type_quad,ipatch) + 1
2099  END IF ! pPatchSerial
2100  END IF ! icg2
2101  ELSE
2102  IF ( ireg == pregion%iRegionGlobal ) THEN ! Cell must exist
2103  CALL errorstop(global,err_cell_not_found,__line__)
2104  END IF ! iReg
2105  END IF ! iLoc
2106  END DO ! ifl
2107 
2108 ! ------------------------------------------------------------------------------
2109 ! For virtual patches, search is unnecessary. Can set number of faces
2110 ! directly, see comment above.
2111 ! ------------------------------------------------------------------------------
2112 
2113  ELSE
2114  pgrid%patchCounter(1,face_type_tri,ipatch) = pgrid%nPris
2115  pgrid%patchCounter(1,face_type_quad,ipatch) = pgrid%nHexs
2116 
2117  pgrid%patchCounter(2,face_type_tri,ipatch) = pgrid%nPrisTot &
2118  - pgrid%nPris
2119  pgrid%patchCounter(2,face_type_quad,ipatch) = pgrid%nHexsTot &
2120  - pgrid%nHexs
2121  END IF ! pPatch%bcType
2122  END DO ! iPatch
2123 
2124 ! ==============================================================================
2125 ! Number of patches is given by sum of patch with non-zero number of actual
2126 ! or virtual faces
2127 ! ==============================================================================
2128 
2129  pgrid%nPatches = 0
2130 
2131  DO ipatch = 1,pgridserial%nPatches
2132  IF ( (pgrid%patchCounter(1,face_type_tri ,ipatch) > 0) .OR. &
2133  (pgrid%patchCounter(2,face_type_tri ,ipatch) > 0) .OR. &
2134  (pgrid%patchCounter(1,face_type_quad,ipatch) > 0) .OR. &
2135  (pgrid%patchCounter(2,face_type_quad,ipatch) > 0) ) THEN
2136  pgrid%nPatches = pgrid%nPatches + 1
2137  END IF ! pGrid%patchCounter
2138  END DO ! iPatch
2139 
2140  IF ( global%verbLevel > verbose_low ) THEN
2141  WRITE(stdout,'(A,3X,A)') solver_name,'Determining number of patches done.'
2142  END IF ! global%verbLevel
2143 
2144 ! ******************************************************************************
2145 ! Allocate memory for patch data structure
2146 ! ******************************************************************************
2147 
2148  ALLOCATE(pregion%patches(pgrid%nPatches),stat=errorflag)
2149  global%error = errorflag
2150  IF ( global%error /= err_none ) THEN
2151  CALL errorstop(global,err_allocate,__line__,'pRegion%patches')
2152  END IF ! global%error
2153 
2154 ! ******************************************************************************
2155 ! Loop over serial patches and set variables if that patch exists on this
2156 ! partition
2157 ! ******************************************************************************
2158 
2159  IF ( global%verbLevel > verbose_low ) THEN
2160  WRITE(stdout,'(A,3X,A)') solver_name,'Determining patch dimensions...'
2161  END IF ! global%verbLevel
2162 
2163  pgrid%nPatches = 0 ! Reset counter
2164 
2165  pgrid%nBFaces = 0
2166  pgrid%nBFacesTot = 0
2167 
2168  DO ipatch = 1,pgridserial%nPatches
2169  ppatchserial => pregionserial%patches(ipatch)
2170 
2171 ! ==============================================================================
2172 ! Patch exists on this partition
2173 ! ==============================================================================
2174 
2175  IF ( (pgrid%patchCounter(1,face_type_tri ,ipatch) > 0) .OR. &
2176  (pgrid%patchCounter(2,face_type_tri ,ipatch) > 0) .OR. &
2177  (pgrid%patchCounter(1,face_type_quad,ipatch) > 0) .OR. &
2178  (pgrid%patchCounter(2,face_type_quad,ipatch) > 0) ) THEN
2179  pgrid%nPatches = pgrid%nPatches + 1
2180 
2181  ppatch => pregion%patches(pgrid%nPatches)
2182 
2183 ! ------------------------------------------------------------------------------
2184 ! Set patch variables
2185 ! ------------------------------------------------------------------------------
2186 
2187  ppatch%iPatchGlobal = ipatch
2188 
2189  ppatch%nBTris = pgrid%patchCounter(1,face_type_tri,ipatch)
2190  ppatch%nBTrisTot = pgrid%patchCounter(1,face_type_tri,ipatch) &
2191  + pgrid%patchCounter(2,face_type_tri,ipatch)
2192 
2193  ppatch%nBQuads = pgrid%patchCounter(1,face_type_quad,ipatch)
2194  ppatch%nBQuadsTot = pgrid%patchCounter(1,face_type_quad,ipatch) &
2195  + pgrid%patchCounter(2,face_type_quad,ipatch)
2196 
2197  ppatch%nBVert = 0
2198  ppatch%nBVertTot = 0
2199 
2200  ppatch%nBFaces = ppatch%nBTris + ppatch%nBQuads
2201  ppatch%nBFacesTot = ppatch%nBTrisTot + ppatch%nBQuadsTot
2202 
2203  pgrid%nBFaces = pgrid%nBFaces + ppatch%nBFaces
2204  pgrid%nBFacesTot = pgrid%nBFacesTot + ppatch%nBFacesTot
2205 
2206  ppatch%nBCellsVirt = 0
2207 
2208  ppatch%bcCoupled = ppatchserial%bcCoupled
2209  ppatch%movePatchDir = ppatchserial%movePatchDir
2210  ppatch%flatFlag = ppatchserial%flatFlag
2211 
2212 ! ------------------------------------------------------------------------------
2213 ! Allocate memory for face lists
2214 ! ------------------------------------------------------------------------------
2215 
2216  IF ( ppatch%nBTrisTot > 0 ) THEN
2217  ALLOCATE(ppatch%bTri2v(3,ppatch%nBTrisTot),stat=errorflag)
2218  global%error = errorflag
2219  IF ( global%error /= err_none ) THEN
2220  CALL errorstop(global,err_allocate,__line__,'pPatch%bTri2v')
2221  END IF ! global%error
2222  ELSE
2223  nullify(ppatch%bTri2v)
2224  END IF ! pPatch%nBTrisTot
2225 
2226  IF ( ppatch%nBQuadsTot > 0 ) THEN
2227  ALLOCATE(ppatch%bQuad2v(4,ppatch%nBQuadsTot),stat=errorflag)
2228  global%error = errorflag
2229  IF ( global%error /= err_none ) THEN
2230  CALL errorstop(global,err_allocate,__line__,'pPatch%bQuad2v')
2231  END IF ! global%error
2232  ELSE
2233  nullify(ppatch%bQuad2v)
2234  END IF ! pPatch%nBQuadTot
2235  END IF ! pGrid%patchCounter
2236  END DO ! iPatch
2237 
2238  IF ( global%verbLevel > verbose_low ) THEN
2239  WRITE(stdout,'(A,3X,A)') solver_name,'Determining patch dimensions done.'
2240  END IF ! global%verbLevel
2241 
2242 ! ******************************************************************************
2243 ! Deallocate temporary memory
2244 ! ******************************************************************************
2245 
2246  DEALLOCATE(pgrid%patchCounter,stat=errorflag)
2247  global%error = errorflag
2248  IF ( global%error /= err_none ) THEN
2249  CALL errorstop(global,err_deallocate,__line__,'pGrid%patchCounter')
2250  END IF ! global%error
2251 
2252 ! ******************************************************************************
2253 ! End
2254 ! ******************************************************************************
2255 
2256  IF ( global%verbLevel > verbose_none ) THEN
2257  WRITE(stdout,'(A,1X,A)') solver_name,'Creating patch lists done.'
2258  END IF ! global%verbLevel
2259 
2260  CALL deregisterfunction(global)
2261 
2262  END SUBROUTINE rflu_part_createpatchlists
2263 
2264 
2265 
2266 
2267 
2268 
2269 
2270 
2271 
2272 
2273 ! ******************************************************************************
2274 !
2275 ! Purpose: Create region-to-cell mapping.
2276 !
2277 ! Description: None.
2278 !
2279 ! Input:
2280 ! levels Level data structure
2281 !
2282 ! Output: None.
2283 !
2284 ! Notes: None.
2285 !
2286 ! ******************************************************************************
2287 
2288  SUBROUTINE rflu_part_createreg2cellmap(pRegion)
2289 
2290  IMPLICIT NONE
2291 
2292 ! ******************************************************************************
2293 ! Declarations and definitions
2294 ! ******************************************************************************
2295 
2296 ! ==============================================================================
2297 ! Arguments
2298 ! ==============================================================================
2299 
2300  TYPE(t_region), POINTER :: pregion
2301 
2302 ! ==============================================================================
2303 ! Locals
2304 ! ==============================================================================
2305 
2306  INTEGER :: errorflag,ireg
2307  TYPE(t_global), POINTER :: global
2308  TYPE(t_grid), POINTER :: pgrid
2309 
2310 ! ******************************************************************************
2311 ! Start
2312 ! ******************************************************************************
2313 
2314  global => pregion%global
2315 
2316  CALL registerfunction(global,'RFLU_PART_CreateReg2CellMap',&
2317  'RFLU_ModPartitionRegion.F90')
2318 
2319  IF ( global%verbLevel > verbose_none ) THEN
2320  WRITE(stdout,'(A,1X,A)') solver_name,'Creating region-to-cell mapping...'
2321  END IF ! global%verbLevel
2322 
2323  IF ( global%verbLevel > verbose_low ) THEN
2324  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2325  pregion%iRegionGlobal
2326  END IF ! global%verbLevel
2327 
2328 ! ******************************************************************************
2329 ! Set pointers
2330 ! ******************************************************************************
2331 
2332  pgrid => pregion%grid
2333 
2334 ! ******************************************************************************
2335 ! Allocate memory for cell mapping
2336 ! ******************************************************************************
2337 
2338  ALLOCATE(pgrid%r2pcCSR(pgrid%nCellsTot),stat=errorflag)
2339  global%error = errorflag
2340  IF ( global%error /= err_none ) THEN
2341  CALL errorstop(global,err_allocate,__line__,'pGrid%r2pcCSR')
2342  END IF ! global%error
2343 
2344  ALLOCATE(pgrid%r2pcCSRInfo(0:global%nRegionsLocal),stat=errorflag)
2345  global%error = errorflag
2346  IF ( global%error /= err_none ) THEN
2347  CALL errorstop(global,err_allocate,__line__,'pGrid%r2pcCSRInfo')
2348  END IF ! global%error
2349 
2350  DO ireg = 0,global%nRegionsLocal
2351  pgrid%r2pcCSRInfo(ireg) = 0 ! Initial value important
2352  END DO ! iReg
2353 
2354 ! ******************************************************************************
2355 ! End
2356 ! ******************************************************************************
2357 
2358  IF ( global%verbLevel > verbose_none ) THEN
2359  WRITE(stdout,'(A,1X,A)') solver_name, &
2360  'Creating region-to-cell mapping done.'
2361  END IF ! global%verbLevel
2362 
2363  CALL deregisterfunction(global)
2364 
2365  END SUBROUTINE rflu_part_createreg2cellmap
2366 
2367 
2368 
2369 
2370 
2371 
2372 
2373 
2374 ! ******************************************************************************
2375 !
2376 ! Purpose: Destroy border face lists.
2377 !
2378 ! Description: None.
2379 !
2380 ! Input:
2381 ! pRegion Pointer to region
2382 !
2383 ! Output: None.
2384 !
2385 ! Notes: None.
2386 !
2387 ! ******************************************************************************
2388 
2389  SUBROUTINE rflu_part_destroyborderfacelist(pRegion)
2390 
2391  IMPLICIT NONE
2392 
2393 ! ******************************************************************************
2394 ! Declarations and definitions
2395 ! ******************************************************************************
2396 
2397 ! ==============================================================================
2398 ! Arguments
2399 ! ==============================================================================
2400 
2401  TYPE(t_region), POINTER :: pregion
2402 
2403 ! ==============================================================================
2404 ! Locals
2405 ! ==============================================================================
2406 
2407  INTEGER :: errorflag
2408  TYPE(t_grid), POINTER :: pgrid
2409  TYPE(t_global), POINTER :: global
2410 
2411 ! ******************************************************************************
2412 ! Start
2413 ! ******************************************************************************
2414 
2415  global => pregion%global
2416 
2417  CALL registerfunction(global,'RFLU_PART_DestroyBorderFaceList',&
2418  'RFLU_ModPartitionRegion.F90')
2419 
2420  IF ( global%verbLevel > verbose_none ) THEN
2421  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying border face lists...'
2422  END IF ! global%verbLevel
2423 
2424  IF ( global%verbLevel > verbose_low ) THEN
2425  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2426  pregion%iRegionGlobal
2427  END IF ! global%verbLevel
2428 
2429 ! ******************************************************************************
2430 ! Set pointers
2431 ! ******************************************************************************
2432 
2433  pgrid => pregion%grid
2434 
2435 ! ******************************************************************************
2436 ! Deallocate memory
2437 ! ******************************************************************************
2438 
2439  DEALLOCATE(pgrid%avfCSRInfo,stat=errorflag)
2440  global%error = errorflag
2441  IF ( global%error /= err_none ) THEN
2442  CALL errorstop(global,err_deallocate,__line__,'pGrid%avfCSRInfo')
2443  END IF ! global%error
2444 
2445  DEALLOCATE(pgrid%avfCSR,stat=errorflag)
2446  global%error = errorflag
2447  IF ( global%error /= err_none ) THEN
2448  CALL errorstop(global,err_deallocate,__line__,'pGrid%avfCSR')
2449  END IF ! global%error
2450 
2451 ! ******************************************************************************
2452 ! End
2453 ! ******************************************************************************
2454 
2455  IF ( global%verbLevel > verbose_none ) THEN
2456  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying border face lists done.'
2457  END IF ! global%verbLevel
2458 
2459  CALL deregisterfunction(global)
2460 
2461  END SUBROUTINE rflu_part_destroyborderfacelist
2462 
2463 
2464 
2465 
2466 
2467 
2468 
2469 ! ******************************************************************************
2470 !
2471 ! Purpose: Destroy cell data.
2472 !
2473 ! Description: None.
2474 !
2475 ! Input:
2476 ! pRegion Pointer to region
2477 !
2478 ! Output: None.
2479 !
2480 ! Notes: None.
2481 !
2482 ! ******************************************************************************
2483 
2484  SUBROUTINE rflu_part_destroycelldata(pRegion)
2485 
2486  IMPLICIT NONE
2487 
2488 ! ******************************************************************************
2489 ! Declarations and definitions
2490 ! ******************************************************************************
2491 
2492 ! ==============================================================================
2493 ! Arguments
2494 ! ==============================================================================
2495 
2496  TYPE(t_region), POINTER :: pregion
2497 
2498 ! ==============================================================================
2499 ! Locals
2500 ! ==============================================================================
2501 
2502  INTEGER :: errorflag
2503  TYPE(t_global), POINTER :: global
2504  TYPE(t_grid), POINTER :: pgrid
2505 
2506 ! ******************************************************************************
2507 ! Start
2508 ! ******************************************************************************
2509 
2510  global => pregion%global
2511 
2512  CALL registerfunction(global,'RFLU_PART_DestroyCellData',&
2513  'RFLU_ModPartitionRegion.F90')
2514 
2515  IF ( global%verbLevel > verbose_none ) THEN
2516  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying cell data...'
2517  END IF ! global%verbLevel
2518 
2519  IF ( global%verbLevel > verbose_low ) THEN
2520  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2521  pregion%iRegionGlobal
2522  END IF ! global%verbLevel
2523 
2524 ! ******************************************************************************
2525 ! Set pointers
2526 ! ******************************************************************************
2527 
2528  pgrid => pregion%grid
2529 
2530 ! ******************************************************************************
2531 ! Deallocate memory for cell data
2532 ! ******************************************************************************
2533 
2534 ! ==============================================================================
2535 ! Mixture
2536 ! ==============================================================================
2537 
2538  DEALLOCATE(pregion%mixt%cv,stat=errorflag)
2539  global%error = errorflag
2540  IF ( global%error /= err_none ) THEN
2541  CALL errorstop(global,err_deallocate,__line__,'pRegion%mixt%cv')
2542  END IF ! global%error
2543 
2544 ! ******************************************************************************
2545 ! End
2546 ! ******************************************************************************
2547 
2548  IF ( global%verbLevel > verbose_none ) THEN
2549  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying cell data done.'
2550  END IF ! global%verbLevel
2551 
2552  CALL deregisterfunction(global)
2553 
2554  END SUBROUTINE rflu_part_destroycelldata
2555 
2556 
2557 
2558 
2559 
2560 
2561 
2562 
2563 ! ******************************************************************************
2564 !
2565 ! Purpose: Destroy cell lists.
2566 !
2567 ! Description: None.
2568 !
2569 ! Input:
2570 ! pRegion Pointer to region
2571 !
2572 ! Output: None.
2573 !
2574 ! Notes: None.
2575 !
2576 ! ******************************************************************************
2577 
2578  SUBROUTINE rflu_part_destroycelllists(pRegion)
2579 
2580  IMPLICIT NONE
2581 
2582 ! ******************************************************************************
2583 ! Declarations and definitions
2584 ! ******************************************************************************
2585 
2586 ! ==============================================================================
2587 ! Arguments
2588 ! ==============================================================================
2589 
2590  TYPE(t_region), POINTER :: pregion
2591 
2592 ! ==============================================================================
2593 ! Locals
2594 ! ==============================================================================
2595 
2596  INTEGER :: errorflag
2597  TYPE(t_grid), POINTER :: pgrid
2598  TYPE(t_global), POINTER :: global
2599 
2600 ! ******************************************************************************
2601 ! Start
2602 ! ******************************************************************************
2603 
2604  global => pregion%global
2605 
2606  CALL registerfunction(global,'RFLU_PART_DestroyCellLists',&
2607  'RFLU_ModPartitionRegion.F90')
2608 
2609  IF ( global%verbLevel > verbose_none ) THEN
2610  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying cell lists...'
2611  END IF ! global%verbLevel
2612 
2613  IF ( global%verbLevel > verbose_low ) THEN
2614  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2615  pregion%iRegionGlobal
2616  END IF ! global%verbLevel
2617 
2618 ! ******************************************************************************
2619 ! Set pointers
2620 ! ******************************************************************************
2621 
2622  pgrid => pregion%grid
2623 
2624 ! ******************************************************************************
2625 ! Deallocate memory
2626 ! ******************************************************************************
2627 
2628  IF ( pgrid%nTetsMax > 0 ) THEN
2629  DEALLOCATE(pgrid%tet2v,stat=errorflag)
2630  global%error = errorflag
2631  IF ( global%error /= err_none ) THEN
2632  CALL errorstop(global,err_deallocate,__line__,'pGrid%tet2v')
2633  END IF ! global%error
2634  END IF ! pGrid%nTetsMax
2635 
2636  IF ( pgrid%nHexsMax > 0 ) THEN
2637  DEALLOCATE(pgrid%hex2v,stat=errorflag)
2638  global%error = errorflag
2639  IF ( global%error /= err_none ) THEN
2640  CALL errorstop(global,err_deallocate,__line__,'pGrid%hex2v')
2641  END IF ! global%error
2642  END IF ! pGrid%nHexsMax
2643 
2644  IF ( pgrid%nPrisMax > 0 ) THEN
2645  DEALLOCATE(pgrid%pri2v,stat=errorflag)
2646  global%error = errorflag
2647  IF ( global%error /= err_none ) THEN
2648  CALL errorstop(global,err_deallocate,__line__,'pGrid%pri2v')
2649  END IF ! global%error
2650  END IF ! pGrid%nPrisMax
2651 
2652  IF ( pgrid%nPyrsMax > 0 ) THEN
2653  DEALLOCATE(pgrid%pyr2v,stat=errorflag)
2654  global%error = errorflag
2655  IF ( global%error /= err_none ) THEN
2656  CALL errorstop(global,err_deallocate,__line__,'pGrid%pyr2v')
2657  END IF ! global%error
2658  END IF ! pGrid%nPyrsMax
2659 
2660 ! ******************************************************************************
2661 ! End
2662 ! ******************************************************************************
2663 
2664  IF ( global%verbLevel > verbose_none ) THEN
2665  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying cell lists done.'
2666  END IF ! global%verbLevel
2667 
2668  CALL deregisterfunction(global)
2669 
2670  END SUBROUTINE rflu_part_destroycelllists
2671 
2672 
2673 
2674 
2675 
2676 
2677 
2678 
2679 ! ******************************************************************************
2680 !
2681 ! Purpose: Destroy patch list.
2682 !
2683 ! Description: None.
2684 !
2685 ! Input:
2686 ! pRegion Pointer to region
2687 !
2688 ! Output: None.
2689 !
2690 ! Notes: None.
2691 !
2692 ! ******************************************************************************
2693 
2694  SUBROUTINE rflu_part_destroypatchlists(pRegion)
2695 
2696  USE modsortsearch
2697 
2698  IMPLICIT NONE
2699 
2700 ! ******************************************************************************
2701 ! Declarations and definitions
2702 ! ******************************************************************************
2703 
2704 ! ==============================================================================
2705 ! Arguments
2706 ! ==============================================================================
2707 
2708  TYPE(t_region), POINTER :: pregion
2709 
2710 ! ==============================================================================
2711 ! Locals
2712 ! ==============================================================================
2713 
2714  INTEGER :: errorflag,ipatch
2715  TYPE(t_grid), POINTER :: pgrid
2716  TYPE(t_global), POINTER :: global
2717  TYPE(t_patch), POINTER :: ppatch
2718 
2719 ! ******************************************************************************
2720 ! Start
2721 ! ******************************************************************************
2722 
2723  global => pregion%global
2724 
2725  CALL registerfunction(global,'RFLU_PART_DestroyPatchLists',&
2726  'RFLU_ModPartitionRegion.F90')
2727 
2728  IF ( global%verbLevel > verbose_none ) THEN
2729  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying patch lists...'
2730  END IF ! global%verbLevel
2731 
2732  IF ( global%verbLevel > verbose_low ) THEN
2733  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2734  pregion%iRegionGlobal
2735  END IF ! global%verbLevel
2736 
2737 ! ******************************************************************************
2738 ! Set pointers
2739 ! ******************************************************************************
2740 
2741  pgrid => pregion%grid
2742 
2743 ! ******************************************************************************
2744 ! Deallocate memory for face lists
2745 ! ******************************************************************************
2746 
2747  DO ipatch = 1,pgrid%nPatches
2748  ppatch => pregion%patches(ipatch)
2749 
2750  IF ( ppatch%nBTrisTot > 0 ) THEN
2751  DEALLOCATE(ppatch%bTri2v,stat=errorflag)
2752  global%error = errorflag
2753  IF ( global%error /= err_none ) THEN
2754  CALL errorstop(global,err_deallocate,__line__,'pPatch%bTri2v')
2755  END IF ! global%error
2756  END IF ! pPatch%nBTrisTot
2757 
2758  IF ( ppatch%nBQuadsTot > 0 ) THEN
2759  DEALLOCATE(ppatch%bQuad2v,stat=errorflag)
2760  global%error = errorflag
2761  IF ( global%error /= err_none ) THEN
2762  CALL errorstop(global,err_deallocate,__line__,'pPatch%bQuad2v')
2763  END IF ! global%error
2764  END IF ! pPatch%nBQuadTot
2765  END DO ! iPatch
2766 
2767 ! ******************************************************************************
2768 ! Deallocate memory for patch lists
2769 ! ******************************************************************************
2770 
2771  DEALLOCATE(pregion%patches,stat=errorflag)
2772  global%error = errorflag
2773  IF ( global%error /= err_none ) THEN
2774  CALL errorstop(global,err_deallocate,__line__,'pRegion%patches')
2775  END IF ! global%error
2776 
2777 ! ******************************************************************************
2778 ! End
2779 ! ******************************************************************************
2780 
2781  IF ( global%verbLevel > verbose_none ) THEN
2782  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying patch lists done.'
2783  END IF ! global%verbLevel
2784 
2785  CALL deregisterfunction(global)
2786 
2787  END SUBROUTINE rflu_part_destroypatchlists
2788 
2789 
2790 
2791 
2792 
2793 
2794 
2795 
2796 ! ******************************************************************************
2797 !
2798 ! Purpose: Destroy vertex data.
2799 !
2800 ! Description: None.
2801 !
2802 ! Input:
2803 ! pRegion Pointer to region
2804 !
2805 ! Output: None.
2806 !
2807 ! Notes: None.
2808 !
2809 ! ******************************************************************************
2810 
2811  SUBROUTINE rflu_part_destroyvertexdata(pRegion)
2812 
2813  IMPLICIT NONE
2814 
2815 ! ******************************************************************************
2816 ! Declarations and definitions
2817 ! ******************************************************************************
2818 
2819 ! ==============================================================================
2820 ! Arguments
2821 ! ==============================================================================
2822 
2823  TYPE(t_region), POINTER :: pregion
2824 
2825 ! ==============================================================================
2826 ! Locals
2827 ! ==============================================================================
2828 
2829  INTEGER :: errorflag
2830  TYPE(t_global), POINTER :: global
2831  TYPE(t_grid), POINTER :: pgrid
2832 
2833 ! ******************************************************************************
2834 ! Start
2835 ! ******************************************************************************
2836 
2837  global => pregion%global
2838 
2839  CALL registerfunction(global,'RFLU_PART_DestroyVertexData',&
2840  'RFLU_ModPartitionRegion.F90')
2841 
2842  IF ( global%verbLevel > verbose_none ) THEN
2843  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying vertex data...'
2844  END IF ! global%verbLevel
2845 
2846  IF ( global%verbLevel > verbose_low ) THEN
2847  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2848  pregion%iRegionGlobal
2849  END IF ! global%verbLevel
2850 
2851 ! ******************************************************************************
2852 ! Set pointers
2853 ! ******************************************************************************
2854 
2855  pgrid => pregion%grid
2856 
2857 ! ******************************************************************************
2858 ! Allocate memory for cell mapping
2859 ! ******************************************************************************
2860 
2861  DEALLOCATE(pgrid%xyz,stat=errorflag)
2862  global%error = errorflag
2863  IF ( global%error /= err_none ) THEN
2864  CALL errorstop(global,err_deallocate,__line__,'pGrid%xyz')
2865  END IF ! global%error
2866 
2867 ! ******************************************************************************
2868 ! End
2869 ! ******************************************************************************
2870 
2871  IF ( global%verbLevel > verbose_none ) THEN
2872  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying vertex data done.'
2873  END IF ! global%verbLevel
2874 
2875  CALL deregisterfunction(global)
2876 
2877  END SUBROUTINE rflu_part_destroyvertexdata
2878 
2879 
2880 
2881 
2882 
2883 
2884 
2885 
2886 
2887 
2888 ! ******************************************************************************
2889 !
2890 ! Purpose: Partition region.
2891 !
2892 ! Description: None.
2893 !
2894 ! Input:
2895 ! pRegion Pointer to region
2896 !
2897 ! Output: None.
2898 !
2899 ! Notes: None.
2900 !
2901 ! ******************************************************************************
2902 
2903  SUBROUTINE rflu_part_partitionregion(pRegion)
2904 
2905  USE rflu_modsymmetryperiodic, ONLY: rflu_sype_havesypepatches
2906 
2907  IMPLICIT NONE
2908 
2909 ! ******************************************************************************
2910 ! Declarations and definitions
2911 ! ******************************************************************************
2912 
2913 ! ==============================================================================
2914 ! Arguments
2915 ! ==============================================================================
2916 
2917  TYPE(t_region), POINTER :: pregion
2918 
2919 ! ==============================================================================
2920 ! Locals
2921 ! ==============================================================================
2922 
2923  INTEGER :: c1,c2,errorflag,icg,icgbeg,icgend,ifg,ifl,ipatch,ireg, &
2924  ncellsperreg,ncellsv2,nfaces,wgtflag
2925  INTEGER, DIMENSION(5) :: options
2926  INTEGER, DIMENSION(:), ALLOCATABLE :: f2ccsr,f2ccsrinfo,vwgt,adjwgt
2927  TYPE(t_grid), POINTER :: pgrid
2928  TYPE(t_global), POINTER :: global
2929  TYPE(t_patch), POINTER :: ppatch
2930 
2931 ! ******************************************************************************
2932 ! Start
2933 ! ******************************************************************************
2934 
2935  global => pregion%global
2936 
2937  CALL registerfunction(global,'RFLU_PART_PartitionRegion',&
2938  'RFLU_ModPartitionRegion.F90')
2939 
2940  IF ( global%verbLevel > verbose_none ) THEN
2941  WRITE(stdout,'(A,1X,A)') solver_name,'Partitioning region...'
2942  END IF ! global%verbLevel
2943 
2944  IF ( global%verbLevel > verbose_low ) THEN
2945  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2946  pregion%iRegionGlobal
2947  END IF ! global%verbLevel
2948 
2949 ! ******************************************************************************
2950 ! Set pointers
2951 ! ******************************************************************************
2952 
2953  pgrid => pregion%grid
2954 
2955 ! ******************************************************************************
2956 ! Convert interior face list to CSR format
2957 ! ******************************************************************************
2958 
2959  IF ( global%verbLevel > verbose_low ) THEN
2960  WRITE(stdout,'(A,3X,A)') solver_name, &
2961  'Converting face list to CSR format...'
2962  END IF ! global%verbLevel
2963 
2964 ! ==============================================================================
2965 ! Allocate memory. NOTE need to include virtual-virtual faces so that cases
2966 ! with virtual cells arising from symmetry and periodic patches can be
2967 ! partitioned properly.
2968 ! ==============================================================================
2969 
2970  nfaces = pgrid%nFaces + pgrid%nFacesVV
2971 
2972  ALLOCATE(f2ccsr(2*nfaces),stat=errorflag)
2973  global%error = errorflag
2974  IF ( global%error /= err_none ) THEN
2975  CALL errorstop(global,err_allocate,__line__,'f2cCSR')
2976  END IF ! global%error
2977 
2978  ALLOCATE(f2ccsrinfo(pgrid%nCellsTot+1),stat=errorflag)
2979  global%error = errorflag
2980  IF ( global%error /= err_none ) THEN
2981  CALL errorstop(global,err_allocate,__line__,'f2cCSRInfo')
2982  END IF ! global%error
2983 
2984  DO icg = 1,pgrid%nCellsTot+1
2985  f2ccsrinfo(icg) = 0 ! Initial value important
2986  END DO ! icg
2987 
2988 ! ==============================================================================
2989 ! Build lists
2990 ! ==============================================================================
2991 
2992 ! ------------------------------------------------------------------------------
2993 ! Compute degree of each cell and sum up to get ending index of range of cell
2994 ! neighbors in CSR list
2995 ! ------------------------------------------------------------------------------
2996 
2997  DO ifg = 1,pgrid%nFaces + pgrid%nFacesVV
2998  c1 = pgrid%f2c(1,ifg)
2999  c2 = pgrid%f2c(2,ifg)
3000 
3001  f2ccsrinfo(c1) = f2ccsrinfo(c1) + 1
3002  f2ccsrinfo(c2) = f2ccsrinfo(c2) + 1
3003  END DO ! ifg
3004 
3005  f2ccsrinfo(1) = f2ccsrinfo(1) + 1
3006 
3007  DO icg = 2,pgrid%nCellsTot
3008  f2ccsrinfo(icg) = f2ccsrinfo(icg) + f2ccsrinfo(icg-1)
3009  END DO ! icg
3010 
3011 ! ------------------------------------------------------------------------------
3012 ! Build CSR list
3013 ! ------------------------------------------------------------------------------
3014 
3015  DO ifg = 1,pgrid%nFaces + pgrid%nFacesVV
3016  c1 = pgrid%f2c(1,ifg)
3017  c2 = pgrid%f2c(2,ifg)
3018 
3019  f2ccsrinfo(c1) = f2ccsrinfo(c1) - 1
3020  f2ccsrinfo(c2) = f2ccsrinfo(c2) - 1
3021 
3022  f2ccsr(f2ccsrinfo(c1)) = c2
3023  f2ccsr(f2ccsrinfo(c2)) = c1
3024  END DO ! ifg
3025 
3026  f2ccsrinfo(pgrid%nCellsTot+1) = 2*nfaces + 1
3027 
3028  IF ( global%verbLevel > verbose_low ) THEN
3029  WRITE(stdout,'(A,3X,A)') solver_name, &
3030  'Converting face list to CSR format done.'
3031  END IF ! global%verbLevel
3032 
3033 ! ******************************************************************************
3034 ! Partition region
3035 ! ******************************************************************************
3036 
3037  IF ( global%verbLevel > verbose_low ) THEN
3038  WRITE(stdout,'(A,3X,A)') solver_name,'Calling partitioner...'
3039  END IF ! global%verbLevel
3040 
3041 ! ==============================================================================
3042 ! Partition using METIS. NOTE distinction between the two METIS calls coded
3043 ! as recommended in METIS manual.
3044 ! ==============================================================================
3045 
3046  IF ( global%prepPartMode == partition_mode_proper ) THEN
3047  ALLOCATE(vwgt(1),stat=errorflag)
3048  global%error = errorflag
3049  IF ( global%error /= err_none ) THEN
3050  CALL errorstop(global,err_allocate,__line__,'vwgt')
3051  END IF ! global%error
3052 
3053  ALLOCATE(adjwgt(1),stat=errorflag)
3054  global%error = errorflag
3055  IF ( global%error /= err_none ) THEN
3056  CALL errorstop(global,err_allocate,__line__,'adjwgt')
3057  END IF ! global%error
3058 
3059  wgtflag = 0 ! No weights on graph
3060  options(1) = 0 ! Use default settings
3061 
3062  IF ( global%nRegionsLocal < 8 ) THEN
3063  CALL metis_partgraphrecursive(pgrid%nCellsTot,f2ccsrinfo,f2ccsr,vwgt, &
3064  adjwgt,wgtflag,1,global%nRegionsLocal, &
3065  options,pgrid%nFacesCut,pgrid%sc2r)
3066  ELSE
3067  CALL metis_partgraphkway(pgrid%nCellsTot,f2ccsrinfo,f2ccsr,vwgt, &
3068  adjwgt,wgtflag,1,global%nRegionsLocal, &
3069  options,pgrid%nFacesCut,pgrid%sc2r)
3070  END IF ! global%nRegionsLocal
3071 
3072  DEALLOCATE(vwgt,stat=errorflag)
3073  global%error = errorflag
3074  IF ( global%error /= err_none ) THEN
3075  CALL errorstop(global,err_deallocate,__line__,'vwgt')
3076  END IF ! global%error
3077 
3078  DEALLOCATE(adjwgt,stat=errorflag)
3079  global%error = errorflag
3080  IF ( global%error /= err_none ) THEN
3081  CALL errorstop(global,err_deallocate,__line__,'adjwgt')
3082  END IF ! global%error
3083 
3084 ! ==============================================================================
3085 ! Impose partition mapping. NOTE need to use only pGrid%nCells to compute
3086 ! nCellsPerReg to avoid problems with virtual cells arising from periodic
3087 ! or symmetry boundaries, otherwise get imbalanced regions. NOTE also need
3088 ! to apportion virtual cells arising from periodic or symmetry boundaries
3089 ! to first and last regions.
3090 ! ==============================================================================
3091 
3092  ELSE IF ( global%prepPartMode == partition_mode_imposed ) THEN
3093 
3094 ! ------------------------------------------------------------------------------
3095 ! Basic imposed mapping
3096 ! ------------------------------------------------------------------------------
3097 
3098  ncellsperreg = pgrid%nCells/global%nRegionsLocal
3099 
3100  DO ireg = 1,global%nRegionsLocal
3101  icgbeg = ncellsperreg*(ireg - 1) + 1
3102  icgend = ncellsperreg* ireg
3103 
3104  IF ( global%verbLevel > verbose_low ) THEN
3105  WRITE(stdout,'(A,5X,I4,2(1X,I9))') solver_name,ireg,icgbeg,icgend
3106  END IF ! global%verbLevel
3107 
3108  DO icg = icgbeg,icgend
3109  pgrid%sc2r(icg) = ireg
3110  END DO ! icg
3111  END DO ! iReg
3112 
3113 ! ------------------------------------------------------------------------------
3114 ! If have virtual cells in serial region, must be due to periodic or
3115 ! symmetry boundaries, and hence need to take these into account in
3116 ! special manner. NOTE code below will only work for periodic boundaries
3117 ! and assumes that virtual cells in serial region are added at opposite
3118 ! ends so can be assigned wholly to the first and last regions without
3119 ! being partitioned themselves.
3120 ! ------------------------------------------------------------------------------
3121 
3122  IF ( pgrid%nCells /= pgrid%nCellsTot ) THEN
3123  IF ( rflu_sype_havesypepatches(pregion) .EQV. .true. ) THEN
3124  IF ( mod(pgrid%nCellsTot-pgrid%nCells,2) == 0 ) THEN
3125  ncellsv2 = (pgrid%nCellsTot-pgrid%nCells)/2
3126 
3127  DO icg = pgrid%nCells+1,pgrid%nCells+ncellsv2
3128  pgrid%sc2r(icg) = 1
3129  END DO ! icg
3130 
3131  DO icg = pgrid%nCells+ncellsv2+1,pgrid%nCellsTot
3132  pgrid%sc2r(icg) = global%nRegionsLocal
3133  END DO ! icg
3134  ELSE
3135  CALL errorstop(global,err_virtualcells_notdb2,__line__)
3136  END IF ! MOD
3137  ELSE
3138  CALL errorstop(global,err_reached_default,__line__)
3139  END IF !
3140  END IF ! pGrid%nCells
3141 
3142  pgrid%nFacesCut = 0
3143 
3144  DO ifg = 1,pgrid%nFaces
3145  c1 = pgrid%f2c(1,ifg)
3146  c2 = pgrid%f2c(2,ifg)
3147 
3148  IF ( pgrid%sc2r(c1) /= pgrid%sc2r(c2) ) THEN
3149  pgrid%nFacesCut = pgrid%nFacesCut + 1
3150  END IF ! pGrid%sc2r
3151  END DO ! ifg
3152 
3153 ! ==============================================================================
3154 ! Default
3155 ! ==============================================================================
3156 
3157  ELSE
3158  CALL errorstop(global,err_reached_default,__line__)
3159  END IF ! global%prepPartMode
3160 
3161  IF ( global%verbLevel > verbose_low ) THEN
3162  WRITE(stdout,'(A,3X,A,1X,I6)') solver_name,'Number of cut faces:', &
3163  pgrid%nFacesCut
3164  WRITE(stdout,'(A,3X,A)') solver_name,'Calling partitioner done.'
3165  END IF ! global%verbLevel
3166 
3167 ! ******************************************************************************
3168 ! Deallocate memory
3169 ! ******************************************************************************
3170 
3171  DEALLOCATE(f2ccsrinfo,stat=errorflag)
3172  global%error = errorflag
3173  IF ( global%error /= err_none ) THEN
3174  CALL errorstop(global,err_deallocate,__line__,'f2cCSRInfo')
3175  END IF ! global%error
3176 
3177  DEALLOCATE(f2ccsr,stat=errorflag)
3178  global%error = errorflag
3179  IF ( global%error /= err_none ) THEN
3180  CALL errorstop(global,err_deallocate,__line__,'f2cCSR')
3181  END IF ! global%error
3182 
3183 ! ******************************************************************************
3184 ! End
3185 ! ******************************************************************************
3186 
3187  IF ( global%verbLevel > verbose_none ) THEN
3188  WRITE(stdout,'(A,1X,A)') solver_name,'Partitioning region done.'
3189  END IF ! global%verbLevel
3190 
3191  CALL deregisterfunction(global)
3192 
3193  END SUBROUTINE rflu_part_partitionregion
3194 
3195 
3196 
3197 
3198 
3199 
3200 
3201 
3202 ! ******************************************************************************
3203 !
3204 ! Purpose: Recreate cell list.
3205 !
3206 ! Description: None.
3207 !
3208 ! Input:
3209 ! global Pointer to global data
3210 ! nVertPerCell Number of vertices per cell
3211 ! nCellsMax Maximum number of cells
3212 ! x2v Connectivity array
3213 ! x2cg Cell mapping array
3214 !
3215 ! Output:
3216 ! nCellsMax Increased maximum number of cells
3217 ! x2v Enlarged connectivity array
3218 ! x2cg Enlarged cell mapping array
3219 !
3220 ! Notes: None.
3221 !
3222 ! ******************************************************************************
3223 
3224  SUBROUTINE rflu_part_recreatecelllist(global,nVertPerCell,nCellsMax,x2v,x2cg)
3225 
3226  IMPLICIT NONE
3227 
3228 ! ******************************************************************************
3229 ! Declarations and definitions
3230 ! ******************************************************************************
3231 
3232 ! ==============================================================================
3233 ! Arguments
3234 ! ==============================================================================
3235 
3236  INTEGER, INTENT(IN) :: nvertpercell
3237  INTEGER, INTENT(INOUT) :: ncellsmax
3238  INTEGER, DIMENSION(:), POINTER :: x2cg
3239  INTEGER, DIMENSION(:,:), POINTER :: x2v
3240  TYPE(t_global), POINTER :: global
3241 
3242 ! ==============================================================================
3243 ! Locals
3244 ! ==============================================================================
3245 
3246  INTEGER :: errorflag,icl,ivl,ncellsmaxold
3247  INTEGER, DIMENSION(:), ALLOCATABLE:: x2cgtemp
3248  INTEGER, DIMENSION(:,:), ALLOCATABLE :: x2vtemp
3249 
3250 ! ******************************************************************************
3251 ! Start
3252 ! ******************************************************************************
3253 
3254  CALL registerfunction(global,'RFLU_PART_RecreateCellList',&
3255  'RFLU_ModPartitionRegion.F90')
3256 
3257 ! ******************************************************************************
3258 ! Increase maximum number of cells
3259 ! ******************************************************************************
3260 
3261  ncellsmaxold = ncellsmax
3262  ncellsmax = 2*ncellsmax
3263 
3264 ! ******************************************************************************
3265 ! Copy existing arrays into larger arrays
3266 ! ******************************************************************************
3267 
3268 ! ==============================================================================
3269 ! Connectivity array
3270 ! ==============================================================================
3271 
3272  ALLOCATE(x2vtemp(nvertpercell,ncellsmaxold),stat=errorflag)
3273  global%error = errorflag
3274  IF ( global%error /= err_none ) THEN
3275  CALL errorstop(global,err_allocate,__line__,'x2vTemp')
3276  END IF ! global%error
3277 
3278  DO icl = 1,ncellsmaxold
3279  DO ivl = 1,nvertpercell
3280  x2vtemp(ivl,icl) = x2v(ivl,icl)
3281  END DO ! ivl
3282  END DO ! icl
3283 
3284  DEALLOCATE(x2v,stat=errorflag)
3285  global%error = errorflag
3286  IF ( global%error /= err_none ) THEN
3287  CALL errorstop(global,err_deallocate,__line__,'x2v')
3288  END IF ! global%error
3289 
3290  ALLOCATE(x2v(nvertpercell,ncellsmax),stat=errorflag)
3291  global%error = errorflag
3292  IF ( global%error /= err_none ) THEN
3293  CALL errorstop(global,err_allocate,__line__,'x2v')
3294  END IF ! global%error
3295 
3296  DO icl = 1,ncellsmaxold
3297  DO ivl = 1,nvertpercell
3298  x2v(ivl,icl) = x2vtemp(ivl,icl)
3299  END DO ! ivl
3300  END DO ! icl
3301 
3302  DEALLOCATE(x2vtemp,stat=errorflag)
3303  global%error = errorflag
3304  IF ( global%error /= err_none ) THEN
3305  CALL errorstop(global,err_deallocate,__line__,'x2vTemp')
3306  END IF ! global%error
3307 
3308 ! ==============================================================================
3309 ! Cell mapping array
3310 ! ==============================================================================
3311 
3312  ALLOCATE(x2cgtemp(ncellsmaxold),stat=errorflag)
3313  global%error = errorflag
3314  IF ( global%error /= err_none ) THEN
3315  CALL errorstop(global,err_allocate,__line__,'x2cgTemp')
3316  END IF ! global%error
3317 
3318  DO icl = 1,ncellsmaxold
3319  x2cgtemp(icl) = x2cg(icl)
3320  END DO ! icl
3321 
3322  DEALLOCATE(x2cg,stat=errorflag)
3323  global%error = errorflag
3324  IF ( global%error /= err_none ) THEN
3325  CALL errorstop(global,err_deallocate,__line__,'x2cg')
3326  END IF ! global%error
3327 
3328  ALLOCATE(x2cg(ncellsmax),stat=errorflag)
3329  global%error = errorflag
3330  IF ( global%error /= err_none ) THEN
3331  CALL errorstop(global,err_allocate,__line__,'x2cg')
3332  END IF ! global%error
3333 
3334  DO icl = 1,ncellsmaxold
3335  x2cg(icl) = x2cgtemp(icl)
3336  END DO ! icl
3337 
3338  DEALLOCATE(x2cgtemp,stat=errorflag)
3339  global%error = errorflag
3340  IF ( global%error /= err_none ) THEN
3341  CALL errorstop(global,err_deallocate,__line__,'x2cgTemp')
3342  END IF ! global%error
3343 
3344 ! ******************************************************************************
3345 ! End
3346 ! ******************************************************************************
3347 
3348  IF ( global%verbLevel > verbose_none ) THEN
3349  WRITE(stdout,'(A,1X,A)') solver_name,'Renumbering vertex lists done.'
3350  END IF ! global%verbLevel
3351 
3352  CALL deregisterfunction(global)
3353 
3354  END SUBROUTINE rflu_part_recreatecelllist
3355 
3356 
3357 
3358 
3359 
3360 
3361 
3362 
3363 
3364 ! ******************************************************************************
3365 !
3366 ! Purpose: Renumber vertex lists.
3367 !
3368 ! Description: None.
3369 !
3370 ! Input:
3371 ! pRegion Pointer to region
3372 !
3373 ! Output: None.
3374 !
3375 ! Notes: None.
3376 !
3377 ! ******************************************************************************
3378 
3379  SUBROUTINE rflu_part_renumbervertexlists(pRegion)
3380 
3381  USE rflu_modrenumberlist, ONLY: rflu_renumberlist2
3382 
3383  IMPLICIT NONE
3384 
3385 ! ******************************************************************************
3386 ! Declarations and definitions
3387 ! ******************************************************************************
3388 
3389 ! ==============================================================================
3390 ! Arguments
3391 ! ==============================================================================
3392 
3393  TYPE(t_region), POINTER :: pregion
3394 
3395 ! ==============================================================================
3396 ! Locals
3397 ! ==============================================================================
3398 
3399  INTEGER :: errorflag,icl,ipatch
3400  TYPE(t_grid), POINTER :: pgrid
3401  TYPE(t_patch), POINTER :: ppatch
3402  TYPE(t_global), POINTER :: global
3403 
3404 ! ******************************************************************************
3405 ! Start
3406 ! ******************************************************************************
3407 
3408  global => pregion%global
3409 
3410  CALL registerfunction(global,'RFLU_PART_RenumberVertexLists',&
3411  'RFLU_ModPartitionRegion.F90')
3412 
3413  IF ( global%verbLevel > verbose_none ) THEN
3414  WRITE(stdout,'(A,1X,A)') solver_name,'Renumbering vertex lists...'
3415  END IF ! global%verbLevel
3416 
3417  IF ( global%verbLevel > verbose_low ) THEN
3418  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
3419  pregion%iRegionGlobal
3420  END IF ! global%verbLevel
3421 
3422 ! ******************************************************************************
3423 ! Set pointers
3424 ! ******************************************************************************
3425 
3426  pgrid => pregion%grid
3427 
3428 ! ******************************************************************************
3429 ! Renumber volume connectivity lists
3430 ! ******************************************************************************
3431 
3432 ! ==============================================================================
3433 ! Tetrahedra
3434 ! ==============================================================================
3435 
3436  IF ( pgrid%nTetsTot > 0 ) THEN
3437  CALL rflu_renumberlist2(global,4,pgrid%nTetsTot, &
3438  pgrid%tet2v(1:4,1:pgrid%nTetsTot), &
3439  pgrid%nVertTot, &
3440  pgrid%sv2pv(1:1,1:pgrid%nVertTot), &
3441  pgrid%sv2pv(2:2,1:pgrid%nVertTot))
3442  END IF ! pGrid%nTetsTot
3443 
3444 ! ==============================================================================
3445 ! Hexahedra
3446 ! ==============================================================================
3447 
3448  IF ( pgrid%nHexsTot > 0 ) THEN
3449  CALL rflu_renumberlist2(global,8,pgrid%nHexsTot, &
3450  pgrid%hex2v(1:8,1:pgrid%nHexsTot), &
3451  pgrid%nVertTot, &
3452  pgrid%sv2pv(1:1,1:pgrid%nVertTot), &
3453  pgrid%sv2pv(2:2,1:pgrid%nVertTot))
3454  END IF ! pGrid%nHexsTot
3455 
3456 ! ==============================================================================
3457 ! Prisms
3458 ! ==============================================================================
3459 
3460  IF ( pgrid%nPrisTot > 0 ) THEN
3461  CALL rflu_renumberlist2(global,6,pgrid%nPrisTot, &
3462  pgrid%pri2v(1:6,1:pgrid%nPrisTot), &
3463  pgrid%nVertTot, &
3464  pgrid%sv2pv(1:1,1:pgrid%nVertTot), &
3465  pgrid%sv2pv(2:2,1:pgrid%nVertTot))
3466  END IF ! pGrid%nPrisTot
3467 
3468 ! ==============================================================================
3469 ! Pyramids
3470 ! ==============================================================================
3471 
3472  IF ( pgrid%nPyrsTot > 0 ) THEN
3473  CALL rflu_renumberlist2(global,5,pgrid%nPyrsTot, &
3474  pgrid%pyr2v(1:5,1:pgrid%nPyrsTot), &
3475  pgrid%nVertTot, &
3476  pgrid%sv2pv(1:1,1:pgrid%nVertTot), &
3477  pgrid%sv2pv(2:2,1:pgrid%nVertTot))
3478  END IF ! pGrid%nPyrsTot
3479 
3480 ! ******************************************************************************
3481 ! Renumber surface connectivity lists
3482 ! ******************************************************************************
3483 
3484  DO ipatch = 1,pgrid%nPatches
3485  ppatch => pregion%patches(ipatch)
3486 
3487  IF ( ppatch%nBTrisTot > 0 ) THEN
3488  CALL rflu_renumberlist2(global,3,ppatch%nBTrisTot, &
3489  ppatch%bTri2v(1:3,1:ppatch%nBTrisTot), &
3490  pgrid%nVertTot, &
3491  pgrid%sv2pv(1:1,1:pgrid%nVertTot), &
3492  pgrid%sv2pv(2:2,1:pgrid%nVertTot))
3493  END IF ! pPatch%nBTrisTot
3494 
3495  IF ( ppatch%nBQuadsTot > 0 ) THEN
3496  CALL rflu_renumberlist2(global,4,ppatch%nBQuadsTot, &
3497  ppatch%bQuad2v(1:4,1:ppatch%nBQuadsTot), &
3498  pgrid%nVertTot, &
3499  pgrid%sv2pv(1:1,1:pgrid%nVertTot), &
3500  pgrid%sv2pv(2:2,1:pgrid%nVertTot))
3501  END IF ! pPatch%nBQuadsTot
3502  END DO ! iPatch
3503 
3504 ! ******************************************************************************
3505 ! End
3506 ! ******************************************************************************
3507 
3508  IF ( global%verbLevel > verbose_none ) THEN
3509  WRITE(stdout,'(A,1X,A)') solver_name,'Renumbering vertex lists done.'
3510  END IF ! global%verbLevel
3511 
3512  CALL deregisterfunction(global)
3513 
3514  END SUBROUTINE rflu_part_renumbervertexlists
3515 
3516 
3517 
3518 
3519 
3520 
3521 
3522 
3523 
3524 ! ******************************************************************************
3525 ! End
3526 ! ******************************************************************************
3527 
3528 END MODULE rflu_modpartitionregion
3529 
3530 
3531 ! ******************************************************************************
3532 !
3533 ! RCS Revision history:
3534 !
3535 ! $Log: RFLU_ModPartitionRegion.F90,v $
3536 ! Revision 1.17 2008/12/06 08:45:03 mtcampbe
3537 ! Updated license.
3538 !
3539 ! Revision 1.16 2008/11/19 22:18:14 mtcampbe
3540 ! Added Illinois Open Source License/Copyright
3541 !
3542 ! Revision 1.15 2006/08/21 19:15:25 haselbac
3543 ! Bug fixes for newly added modifications
3544 !
3545 ! Revision 1.14 2006/08/21 16:45:24 haselbac
3546 ! Bug fix or extension: Balanced partitioning with periodic boundaries
3547 !
3548 ! Revision 1.13 2006/04/12 16:11:32 haselbac
3549 ! Bug fix in building patch lists, did not loop over nBFacesTot
3550 !
3551 ! Revision 1.12 2006/03/25 22:05:48 haselbac
3552 ! Substantial changes because of sype patches
3553 !
3554 ! Revision 1.11 2005/12/03 19:36:40 haselbac
3555 ! Bug fix: Removed hardcoded IF statement on pGrid%nTetsTot
3556 !
3557 ! Revision 1.10 2005/08/05 15:28:28 haselbac
3558 ! Improved speed of routines for creating and building patch data str
3559 !
3560 ! Revision 1.9 2005/07/06 15:55:38 haselbac
3561 ! Added imposed partitioning mode
3562 !
3563 ! Revision 1.8 2005/07/03 02:42:51 haselbac
3564 ! Bug fix: Removed INTENT attribute from pointer declarations
3565 !
3566 ! Revision 1.7 2005/07/01 16:17:59 haselbac
3567 ! Changed adding of virtual cells so will not exceed max dims anymore
3568 !
3569 ! Revision 1.6 2005/06/13 22:44:09 haselbac
3570 ! Bug fix: Initialize movePatchDir
3571 !
3572 ! Revision 1.5 2005/05/05 01:44:57 haselbac
3573 ! Increased max number of cells for small cases
3574 !
3575 ! Revision 1.4 2005/05/04 03:37:18 haselbac
3576 ! Bug fix: Added setting of bcCoupled when creating patches
3577 !
3578 ! Revision 1.3 2005/04/21 01:39:24 haselbac
3579 ! Modified building of vertex lists, creation and building of patch lists
3580 !
3581 ! Revision 1.2 2005/04/20 14:47:30 haselbac
3582 ! Changed setting of max cell dimensions
3583 !
3584 ! Revision 1.1 2005/04/15 15:09:12 haselbac
3585 ! Initial revision
3586 !
3587 ! Revision 1.6 2005/01/20 14:56:19 haselbac
3588 ! Some clean-up, adapted to RNMB changes, added use of sbc2pc mapping
3589 !
3590 ! Revision 1.5 2005/01/17 19:49:11 haselbac
3591 ! Proper specification of virtual cells, bug fix, clean-up
3592 !
3593 ! Revision 1.4 2004/12/29 21:13:11 haselbac
3594 ! Substantial changes, creations of virtual cells and bface renumb
3595 !
3596 ! Revision 1.3 2004/12/04 03:41:05 haselbac
3597 ! Substantial rewrite and expansion
3598 !
3599 ! Revision 1.2 2004/11/11 15:11:24 haselbac
3600 ! Commented out METIS calls so as not to break compilation on some machines
3601 !
3602 ! Revision 1.1 2004/11/08 23:27:01 haselbac
3603 ! Initial revision, work in progress
3604 !
3605 ! ******************************************************************************
3606 
3607 
3608 
3609 
3610 
3611 
3612 
3613 
3614 
3615 
3616 
3617 
3618 
3619 
3620 
3621 
3622 
3623 
3624 
3625 
3626 
3627 
3628 
3629 
ibeg
**********************************************************************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 ibeg
Definition: RFLO_GetPatchIndices.h:27
rflu_modpartitionregionutils
Definition: RFLU_ModPartitionRegionUtils.F90:39
rflu_modpartitionregion::rflu_part_destroyborderfacelist
subroutine, public rflu_part_destroyborderfacelist(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2389
rflu_modhashtable::rflu_createhashtable
subroutine, public rflu_createhashtable(global, size)
Definition: RFLU_ModHashTable.F90:131
rflu_modrenumberings
Definition: RFLU_ModRenumberings.F90:40
rflu_modpartitionregion::rflu_part_buildvertexlists
subroutine, public rflu_part_buildvertexlists(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:1387
rflu_modpartitionregionutils::rflu_part_addvirtualcellsinv2
subroutine, public rflu_part_addvirtualcellsinv2(pRegion, pRegionSerial, vc, nCellsVirtMax, nCellsVirt)
Definition: RFLU_ModPartitionRegionUtils.F90:237
rflu_modhashtable::rflu_destroyhashtable
subroutine, public rflu_destroyhashtable(global)
Definition: RFLU_ModHashTable.F90:210
rflu_modpartitionregion
Definition: RFLU_ModPartitionRegion.F90:39
rflu_modpartitionregion::rflu_part_buildcelllists
subroutine, public rflu_part_buildcelllists(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:595
rflu_modpartitionregion::rflu_part_destroypatchlists
subroutine, public rflu_part_destroypatchlists(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2694
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
rflu_modhashtable::rflu_hashbuildkey
subroutine, public rflu_hashbuildkey(a, aSize, key)
Definition: RFLU_ModHashTable.F90:339
rflu_modpartitionregion::rflu_part_buildpatchlists
subroutine, public rflu_part_buildpatchlists(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:821
modgrid::t_grid
Definition: ModGrid.F90:56
modsortsearch::binarysearchinteger
subroutine binarysearchinteger(a, n, v, i, j)
Definition: ModSortSearch.F90:98
rflu_modpartitionregion::rflu_part_renumbervertexlists
subroutine, public rflu_part_renumbervertexlists(pRegion)
Definition: RFLU_ModPartitionRegion.F90:3379
rflu_modrenumberlist
Definition: RFLU_ModRenumberList.F90:39
rflu_modhashtable::rflu_hashvertexfancy
subroutine, public rflu_hashvertexfancy(global, key, ivg, nVert, vert, indx, ivgStat, ivgIndx)
Definition: RFLU_ModHashTable.F90:962
rflu_modpartitionregion::rflu_part_addvirtualcells
subroutine, public rflu_part_addvirtualcells(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:106
rflu_modpartitionregion::rflu_part_destroycelldata
subroutine, public rflu_part_destroycelldata(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2484
rflu_modpartitionregion::rflu_part_destroycelllists
subroutine, public rflu_part_destroycelllists(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2578
iend
**********************************************************************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 knode iend
Definition: RFLO_CalcGradDummySymm.h:32
rflu_modpartitionregion::rflu_part_destroyvertexdata
subroutine, public rflu_part_destroyvertexdata(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2811
rflu_modpartitionregion::rflu_part_partitionregion
subroutine, public rflu_part_partitionregion(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2903
rflu_modpartitionregionutils::rflu_part_addvirtualcellsinv1
subroutine, public rflu_part_addvirtualcellsinv1(pRegion, pRegionSerial, vc, nCellsVirtMax, nCellsVirt)
Definition: RFLU_ModPartitionRegionUtils.F90:97
Mesh::GenericElement::nfaces
IndexType nfaces() const
Definition: Mesh.H:641
modsortsearch::quicksortintegerinteger
subroutine quicksortintegerinteger(a, b, n)
Definition: ModSortSearch.F90:602
rflu_modrenumberlist::rflu_renumberlist2
subroutine, public rflu_renumberlist2(global, listDim1, listDim2, list, keyDim, key1, key2)
Definition: RFLU_ModRenumberList.F90:264
i
blockLoc i
Definition: read.cpp:79
rflu_modpartitionregion::rflu_part_createreg2cellmap
subroutine, public rflu_part_createreg2cellmap(pRegion)
Definition: RFLU_ModPartitionRegion.F90:2288
j
j indices j
Definition: Indexing.h:6
rflu_modrenumberings::rflu_rnmb_createpv2svmap
subroutine, public rflu_rnmb_createpv2svmap(pRegion)
Definition: RFLU_ModRenumberings.F90:1086
rflu_modpartitionregion::rflu_part_buildborderfacelist
subroutine, public rflu_part_buildborderfacelist(pRegion)
Definition: RFLU_ModPartitionRegion.F90:407
rflu_modpartitionregion::rflu_part_buildvertexdata
subroutine, public rflu_part_buildvertexdata(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:1288
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
rflu_modpartitionregion::rflu_part_buildreg2cellmap
subroutine, public rflu_part_buildreg2cellmap(pRegion)
Definition: RFLU_ModPartitionRegion.F90:1176
rflu_modpartitionregion::rflu_part_recreatecelllist
subroutine rflu_part_recreatecelllist(global, nVertPerCell, nCellsMax, x2v, x2cg)
Definition: RFLU_ModPartitionRegion.F90:3224
rflu_modhashtable
Definition: RFLU_ModHashTable.F90:44
rflu_modsymmetryperiodic
Definition: RFLU_ModSymmetryPeriodic.F90:39
rflu_modpartitionregion::rflu_part_createpatchlists
subroutine, public rflu_part_createpatchlists(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:1968
key
static T_Key key
Definition: vinci_lass.c:76
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modpartitionregion::rflu_part_createcelllists
subroutine, public rflu_part_createcelllists(pRegion, pRegionSerial)
Definition: RFLU_ModPartitionRegion.F90:1722
rflu_modsymmetryperiodic::rflu_sype_havesypepatches
LOGICAL function, public rflu_sype_havesypepatches(pRegion)
Definition: RFLU_ModSymmetryPeriodic.F90:2899
modbndpatch::t_patch
Definition: ModBndPatch.F90:91