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