61 CHARACTER(CHRLEN) :: &
62 RCSIdentString =
'$RCSfile: RFLU_ModMergeRegions.F90,v $ $Revision: 1.10 $'
106 TYPE(t_region
),
POINTER :: pregion,pregionserial
112 INTEGER :: icg,icg2,icl,icl2,ict2,ifl,ifl2,ipatch,ivg,ivl,ivg2,offs
113 TYPE(t_grid),
POINTER :: pgrid,pgridserial
115 TYPE(t_patch),
POINTER :: ppatch,ppatchserial
121 global => pregion%global
124 'RFLU_ModMergeRegions.F90')
126 IF ( global%verbLevel > verbose_none )
THEN
127 WRITE(stdout,
'(A,1X,A)') solver_name,
'Merging grid...'
130 IF ( global%verbLevel > verbose_low )
THEN
131 WRITE(stdout,
'(A,3X,A,1X,I5.5)') solver_name,
'Global region:', &
132 pregion%iRegionGlobal
139 pgrid => pregion%grid
140 pgridserial => pregionserial%grid
146 IF ( global%verbLevel > verbose_low )
THEN
147 WRITE(stdout,
'(A,3X,A)') solver_name,
'Merging vertex coordinates...'
150 DO ivg = 1,pgrid%nVertTot
151 ivg2 = pgrid%pv2sv(ivg)
153 pgridserial%xyz(xcoord,ivg2) = pgrid%xyz(xcoord,ivg)
154 pgridserial%xyz(ycoord,ivg2) = pgrid%xyz(ycoord,ivg)
155 pgridserial%xyz(zcoord,ivg2) = pgrid%xyz(zcoord,ivg)
162 IF ( global%verbLevel > verbose_low )
THEN
163 WRITE(stdout,
'(A,3X,A)') solver_name,
'Merging cell connectivity...'
170 IF ( (global%verbLevel > verbose_low) .AND. (pgrid%nTetsTot > 0) )
THEN
171 WRITE(stdout,
'(A,5X,A)') solver_name,
'Tetrahedra...'
174 DO icl = 1,pgrid%nTetsTot
175 icg = pgrid%tet2CellGlob(icl)
176 icg2 = pgrid%pc2sc(icg)
178 ict2 = pgridserial%cellGlob2Loc(1,icg2)
179 icl2 = pgridserial%cellGlob2Loc(2,icg2)
181 IF ( ict2 /= cell_type_tet )
THEN
182 CALL
errorstop(global,err_cell_type_invalid,__line__)
186 ivg = pgrid%tet2v(ivl,icl)
187 ivg2 = pgrid%pv2sv(ivg)
189 pgridserial%tet2v(ivl,icl2) = ivg2
197 IF ( (global%verbLevel > verbose_low) .AND. (pgrid%nHexsTot > 0) )
THEN
198 WRITE(stdout,
'(A,5X,A)') solver_name,
'Hexahedra...'
201 DO icl = 1,pgrid%nHexsTot
202 icg = pgrid%hex2CellGlob(icl)
203 icg2 = pgrid%pc2sc(icg)
205 ict2 = pgridserial%cellGlob2Loc(1,icg2)
206 icl2 = pgridserial%cellGlob2Loc(2,icg2)
208 IF ( ict2 /= cell_type_hex )
THEN
209 CALL
errorstop(global,err_cell_type_invalid,__line__)
213 ivg = pgrid%hex2v(ivl,icl)
214 ivg2 = pgrid%pv2sv(ivg)
216 pgridserial%hex2v(ivl,icl2) = ivg2
224 IF ( (global%verbLevel > verbose_low) .AND. (pgrid%nPrisTot > 0) )
THEN
225 WRITE(stdout,
'(A,5X,A)') solver_name,
'Prisms...'
228 DO icl = 1,pgrid%nPrisTot
229 icg = pgrid%pri2CellGlob(icl)
230 icg2 = pgrid%pc2sc(icg)
232 ict2 = pgridserial%cellGlob2Loc(1,icg2)
233 icl2 = pgridserial%cellGlob2Loc(2,icg2)
235 IF ( ict2 /= cell_type_pri )
THEN
236 CALL
errorstop(global,err_cell_type_invalid,__line__)
240 ivg = pgrid%pri2v(ivl,icl)
241 ivg2 = pgrid%pv2sv(ivg)
243 pgridserial%pri2v(ivl,icl2) = ivg2
251 IF ( (global%verbLevel > verbose_low) .AND. (pgrid%nPyrsTot > 0) )
THEN
252 WRITE(stdout,
'(A,5X,A)') solver_name,
'Pyramids...'
255 DO icl = 1,pgrid%nPyrsTot
256 icg = pgrid%pyr2CellGlob(icl)
257 icg2 = pgrid%pc2sc(icg)
259 ict2 = pgridserial%cellGlob2Loc(1,icg2)
260 icl2 = pgridserial%cellGlob2Loc(2,icg2)
262 IF ( ict2 /= cell_type_pyr )
THEN
263 CALL
errorstop(global,err_cell_type_invalid,__line__)
267 ivg = pgrid%pyr2v(ivl,icl)
268 ivg2 = pgrid%pv2sv(ivg)
270 pgridserial%pyr2v(ivl,icl2) = ivg2
278 IF ( global%myProcid == masterproc .AND. &
279 global%verbLevel > verbose_low )
THEN
280 WRITE(stdout,
'(A,3X,A)') solver_name,
'Merging patch connectivity...'
287 DO ipatch = 1,pgrid%nPatches
288 ppatch => pregion%patches(ipatch)
289 ppatchserial => pregionserial%patches(ppatch%iPatchGlobal)
291 IF ( global%verbLevel > verbose_low )
THEN
292 WRITE(stdout,
'(A,5X,A,2(1X,I2))') solver_name,
'Patch:',ipatch, &
300 IF ( (global%verbLevel > verbose_low) .AND. (ppatch%nBTrisTot > 0) )
THEN
301 WRITE(stdout,
'(A,7X,A)') solver_name,
'Triangles...'
304 offs = pgrid%pbf2sbfCSRInfo(ipatch) - 1
306 DO ifl = 1,ppatch%nBTrisTot
307 ifl2 = pgrid%pbf2sbfCSR(offs+ifl)
310 ivg = ppatch%bTri2v(ivl,ifl)
311 ivg2 = pgrid%pv2sv(ivg)
313 ppatchserial%bTri2v(ivl,ifl2) = ivg2
321 IF ( (global%verbLevel > verbose_low) .AND. (ppatch%nBQuadsTot > 0) )
THEN
322 WRITE(stdout,
'(A,7X,A)') solver_name,
'Quadrilaterals...'
325 offs = offs + ppatch%nBTrisTot
327 DO ifl = 1,ppatch%nBQuadsTot
328 ifl2 = pgrid%pbf2sbfCSR(offs+ifl) - ppatchserial%nBTrisTot
331 ivg = ppatch%bQuad2v(ivl,ifl)
332 ivg2 = pgrid%pv2sv(ivg)
334 ppatchserial%bQuad2v(ivl,ifl2) = ivg2
343 IF ( global%verbLevel > verbose_none )
THEN
344 WRITE(stdout,
'(A,1X,A)') solver_name,
'Merging grid done.'
386 TYPE(t_region
),
POINTER :: pregion,pregionserial
392 INTEGER :: ifl,ifl2,ipatch,offs
394 TYPE(t_grid),
POINTER :: pgrid,pgridserial
395 TYPE(t_patch),
POINTER :: ppatch,ppatchserial
401 global => pregion%global
404 'RFLU_ModMergeRegions.F90')
406 IF ( global%verbLevel > verbose_none )
THEN
407 WRITE(stdout,
'(A,1X,A)') solver_name,
'Merging patch coefficients...'
410 IF ( global%verbLevel > verbose_low )
THEN
411 WRITE(stdout,
'(A,3X,A,1X,I5.5)') solver_name,
'Global region:', &
412 pregion%iRegionGlobal
419 pgrid => pregion%grid
420 pgridserial => pregionserial%grid
426 DO ipatch = 1,pgrid%nPatches
427 ppatch => pregion%patches(ipatch)
429 ppatchserial => pregionserial%patches(ppatch%iPatchGlobal)
431 offs = pgrid%pbf2sbfCSRInfo(ipatch) - 1
433 DO ifl = 1,ppatch%nBTris
434 ifl2 = pgrid%pbf2sbfCSR(offs+ifl)
436 ppatchserial%cp( ifl2) = ppatch%cp( ifl)
437 ppatchserial%cf(xcoord,ifl2) = ppatch%cf(xcoord,ifl)
438 ppatchserial%cf(ycoord,ifl2) = ppatch%cf(ycoord,ifl)
439 ppatchserial%cf(zcoord,ifl2) = ppatch%cf(zcoord,ifl)
440 ppatchserial%ch( ifl2) = ppatch%ch( ifl)
443 offs = offs + ppatch%nBTrisTot
445 DO ifl = 1,ppatch%nBQuads
446 ifl2 = pgrid%pbf2sbfCSR(offs+ifl)
448 ppatchserial%cp( ifl2) = ppatch%cp( ifl)
449 ppatchserial%cf(xcoord,ifl2) = ppatch%cf(xcoord,ifl)
450 ppatchserial%cf(ycoord,ifl2) = ppatch%cf(ycoord,ifl)
451 ppatchserial%cf(zcoord,ifl2) = ppatch%cf(zcoord,ifl)
452 ppatchserial%ch( ifl2) = ppatch%ch( ifl)
460 IF ( global%verbLevel > verbose_none )
THEN
461 WRITE(stdout,
'(A,1X,A)') solver_name,
'Merging patch coefficients done.'
512 TYPE(t_region
),
POINTER :: pregion,pregionserial
519 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: pcv,pcvserial
520 TYPE(t_grid),
POINTER :: pgrid
523 TYPE(t_plag),
POINTER :: pplag,pplagserial
530 global => pregion%global
533 'RFLU_ModMergeRegions.F90')
535 IF ( global%verbLevel > verbose_none )
THEN
536 WRITE(stdout,
'(A,1X,A)') solver_name,
'Merging solution...'
539 IF ( global%verbLevel > verbose_low )
THEN
540 WRITE(stdout,
'(A,3X,A,1X,I5.5)') solver_name,
'Global region:', &
541 pregion%iRegionGlobal
548 pgrid => pregion%grid
558 pregionserial%mixt%cvState = cv_mixt_state_cons
561 pregionserial%mixt%cv)
572 IF ( global%specUsed .EQV. .true. )
THEN
573 pregionserial%spec%cvState = cv_mixt_state_cons
576 pregionserial%spec%cv)
578 IF ( pregion%specInput%nSpeciesEE > 0 )
THEN
580 pregionserial%spec%eev)
590 IF ( global%plagUsed .EQV. .true. )
THEN
591 pplag => pregion%plag
592 pplagserial => pregionserial%plag
602 IF ( global%verbLevel > verbose_none )
THEN
603 WRITE(stdout,
'(A,1X,A)') solver_name,
'Merging solution done.'
subroutine, public rflu_copy_celldatap2s_r3d(global, pGrid, var, varSerial)
subroutine registerfunction(global, funName, fileName)
subroutine, public rflu_copy_celldatap2s_r2d(global, pGrid, var, varSerial)
subroutine, public rflu_merg_mergegrid(pRegion, pRegionSerial)
subroutine, public plag_dstr_mergeparticlewrapper(pRegion, pPlag, pPlag2)
subroutine, public rflu_merg_mergesolwrapper(pRegion, pRegionSerial)
subroutine, public rflu_merg_mergepatchcoeffs(pRegion, pRegionSerial)
subroutine errorstop(global, errorCode, errorLine, addMessage)
subroutine deregisterfunction(global)