Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_RFLO_SendMetrics.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: send RFLO metrics to edge and corner cells of an adjacent region.
26 !
27 ! Description: kernel is pertinent when the other region is located
28 ! on a different processor.
29 !
30 ! Input: regions = data of all regions
31 ! iReg = current region.
32 !
33 ! Output: new values of RFLO metrics variables.
34 !
35 ! Notes: none.
36 !
37 !******************************************************************************
38 !
39 ! $Id: PLAG_RFLO_SendMetrics.F90,v 1.5 2009/03/02 00:19:36 mtcampbe Exp $
40 !
41 ! Copyright: (c) 2004 by the University of Illinois
42 !
43 !******************************************************************************
44 
45 SUBROUTINE plag_rflo_sendmetrics( regions,iReg )
46 
47  USE moddatatypes
48  USE modglobal, ONLY : t_global
49  USE moddatastruct, ONLY : t_region, t_level, t_dcelltransf
50  USE modpartlag, ONLY : t_plag
51  USE moderror
52  USE modmpi
53  USE modparameters
54  USE modindexing, ONLY : getijk
55  USE modinterfaces, ONLY : rflo_getcelloffset, &
60  IMPLICIT NONE
61 
62 #include "Indexing.h"
63 
64 ! ... parameters
65  TYPE(t_region), POINTER :: regions(:)
66 
67  INTEGER, INTENT(IN) :: ireg
68 
69 ! ... loop variables
70  INTEGER :: i,j,k, icorner, iedge, iface, ijk, ir, ldir
71 
72 ! ... local variables
73  INTEGER :: ilev, iregsrc, icell, ibuff, ndim, dest, tag
74  INTEGER :: nbuffsize, ncorners, nedges, ndir
75  INTEGER :: nfaces, nfacecentroidsize, nfacenormalsize
76  INTEGER :: icoffsrc, ijcoffsrc
77  INTEGER :: ijkccsrc, ijkecsrc
78  INTEGER :: iccsrc, jccsrc, kccsrc
79  INTEGER :: iecsrc, jecsrc, kecsrc
80  INTEGER :: ndumcellssrc
81  INTEGER :: inoff, ijnoff
82  INTEGER :: inoffsrc, ijnoffsrc, ijkn, ijkcnsrc, ijkensrc
83  INTEGER :: icnsrc, jcnsrc, kcnsrc
84  INTEGER :: iensrc, jensrc, kensrc
85  INTEGER :: nodecornsrc, nodeedgesrc
86  INTEGER :: idirsrc, jdirsrc, kdirsrc, ldirsrc, ifacesrc
87  INTEGER :: srcdir(3),srcface(6)
88  INTEGER :: srcindexmapmat(3,4)
89 
90  REAL(RFREAL), DIMENSION(3,3) :: sfacecorn, sfaceedge
91  REAL(RFREAL), POINTER, DIMENSION(:,:) :: psi, psj, psk
92  REAL(RFREAL), POINTER, DIMENSION(:,:,:) :: pfc
93 
94  TYPE(t_region), POINTER :: pregion
95  TYPE(t_level), POINTER :: plevel
96  TYPE(t_dcelltransf), POINTER :: psendeccell
97  TYPE(t_plag), POINTER :: pplag
98  TYPE(t_global), POINTER :: global
99 
100 !******************************************************************************
101 
102  global => regions(ireg)%global
103 
104  CALL registerfunction( global,'PLAG_RFLO_SendMetrics',&
105  'PLAG_RFLO_SendMetrics.F90' )
106 
107 ! Get dimensions --------------------------------------------------------------
108 
109  ilev = regions(ireg)%currLevel
110  ncorners = 8
111  nedges = 12
112  nfaces = 6
113  ndir = 3
114 
115 ! Compute buffer size has to store information --------------------------------
116 ! on the total number of faces for each cell .
117 
118  nfacecentroidsize = zcoord*kcoord
119  nfacenormalsize = 3*kcoord
120  nbuffsize = (nfacecentroidsize + nfacenormalsize)
121 
122 ! Set pointers ----------------------------------------------------------------
123 
124  pregion => regions(ireg)
125  pplag => regions(ireg)%levels(ilev)%plag
126  pfc => regions(ireg)%levels(ilev)%plag%fc
127  psi => regions(ireg)%levels(ilev)%plag%si
128  psj => regions(ireg)%levels(ilev)%plag%sj
129  psk => regions(ireg)%levels(ilev)%plag%sk
130 
131 ! Get node offset -------------------------------------------------------------
132 
133  CALL rflo_getnodeoffset( pregion,ilev,inoff,ijnoff )
134 
135 ! Fill send buffers -----------------------------------------------------------
136 
137  DO ir=1,global%nRegions
138  IF (regions(ir)%procid /= global%myProcid) THEN
139  IF (regions(ireg)%levels(ilev)%sendEcCells(ir)%nCells > 0) THEN
140 
141  psendeccell => regions(ireg)%levels(ilev)%sendEcCells(ir)
142  plevel => regions(ir)%levels(ilev)
143  ndim = psendeccell%nCells*nfaces
144  ibuff = 0
145 
146 ! - Load edges ----------------------------------------------------------------
147 
148  DO iedge=1,nedges
149 
150 ! -- Bypass for noninteracting regions ----------------------------------------
151 
152  IF( .NOT. plevel%edgeCells(iedge)%interact ) goto 1999
153 
154 ! -- Bypass for degenerate edge cells -----------------------------------------
155 
156  IF( plevel%edgeCells(iedge)%degenrt /= degenerat_none ) goto 1999
157 
158 ! -- Source region infrastructure ---------------------------------------------
159 
160  DO ijk=1,ubound(plevel%edgeCells(iedge)%cells,1)
161  iregsrc = plevel%edgeCells(iedge)%cells(ijk)%srcRegion
162 
163  IF ( iregsrc == ireg ) THEN
164  ijkecsrc = plevel%edgeCells(iedge)%cells(ijk)%srcCell
165  ndumcellssrc = regions(iregsrc)%nDumCells
166 
167  CALL rflo_getcelloffset( regions(iregsrc),ilev,icoffsrc,ijcoffsrc )
168  CALL getijk( ijkecsrc,icoffsrc,ijcoffsrc,ndumcellssrc, &
169  iecsrc,jecsrc,kecsrc )
170 
171  CALL rflo_getnodeoffset( regions(iregsrc),ilev,inoffsrc,ijnoffsrc )
172  ijkensrc = indijk(iecsrc,jecsrc,kecsrc,inoffsrc,ijnoffsrc)
173 
174 ! -- Find face mapping for source region --------------------------------------
175 
176  srcindexmapmat= plevel%edgeCells(iedge)%cells(ijk)%srcIndexMapMat
177 
178  CALL plag_rflo_getfacemapping(srcindexmapmat,srcdir,srcface)
179 
180  idirsrc = srcdir(1); jdirsrc = srcdir(2); kdirsrc = srcdir(3);
181 
182 ! --- Loop over all the Faces -------------------------------------------------
183 ! --- Note: assumption of coordinate alignment between regions removed --------
184 
185  DO iface = 1, nfaces
186  ibuff = ibuff + 1
187 
188  ifacesrc = srcface(iface)
189  SELECT CASE (ifacesrc)
190  CASE(1,3,5)
191  nodeedgesrc = indijk(iecsrc,jecsrc,kecsrc,inoffsrc,ijnoffsrc)
192 
193  CASE(2)
194  nodeedgesrc = indijk(iecsrc+1,jecsrc,kecsrc,inoffsrc,ijnoffsrc)
195 
196  CASE(4)
197  nodeedgesrc = indijk(iecsrc,jecsrc+1,kecsrc,inoffsrc,ijnoffsrc)
198 
199  CASE(6)
200  nodeedgesrc = indijk(iecsrc,jecsrc,kecsrc+1,inoffsrc,ijnoffsrc)
201  END SELECT ! iFaceSrc
202 
203 ! --- Determine direction mapping for face normals ----------------------------
204 
205  DO ldir = 1,ndir
206  ldirsrc=srcdir(ldir)
207  SELECT CASE (ldirsrc)
208  CASE(icoord)
209  sfaceedge(xcoord:zcoord,ldirsrc) = psi(xcoord:zcoord,nodeedgesrc)
210 
211  CASE(jcoord)
212  sfaceedge(xcoord:zcoord,ldirsrc) = psj(xcoord:zcoord,nodeedgesrc)
213 
214  CASE(kcoord)
215  sfaceedge(xcoord:zcoord,ldirsrc) = psk(xcoord:zcoord,nodeedgesrc)
216  END SELECT ! ldirSrc
217  ENDDO ! ldir
218 
219 ! ---- Load face centroids -----------------------------------------------------
220 
221  psendeccell%buffMetrics(ibuff ) = pfc(xcoord,idirsrc,nodeedgesrc)
222  psendeccell%buffMetrics(ibuff+ ndim) = pfc(xcoord,jdirsrc,nodeedgesrc)
223  psendeccell%buffMetrics(ibuff+ 2*ndim) = pfc(xcoord,kdirsrc,nodeedgesrc)
224 
225  psendeccell%buffMetrics(ibuff+ 3*ndim) = pfc(ycoord,idirsrc,nodeedgesrc)
226  psendeccell%buffMetrics(ibuff+ 4*ndim) = pfc(ycoord,jdirsrc,nodeedgesrc)
227  psendeccell%buffMetrics(ibuff+ 5*ndim) = pfc(ycoord,kdirsrc,nodeedgesrc)
228 
229  psendeccell%buffMetrics(ibuff+ 6*ndim) = pfc(zcoord,idirsrc,nodeedgesrc)
230  psendeccell%buffMetrics(ibuff+ 7*ndim) = pfc(zcoord,jdirsrc,nodeedgesrc)
231  psendeccell%buffMetrics(ibuff+ 8*ndim) = pfc(zcoord,kdirsrc,nodeedgesrc)
232 
233 ! --- Load face normals -------------------------------------------------------
234 
235  psendeccell%buffMetrics(ibuff+ 9*ndim) = sfaceedge(xcoord,icoord)
236  psendeccell%buffMetrics(ibuff+10*ndim) = sfaceedge(ycoord,icoord)
237  psendeccell%buffMetrics(ibuff+11*ndim) = sfaceedge(zcoord,icoord)
238 
239  psendeccell%buffMetrics(ibuff+12*ndim) = sfaceedge(xcoord,jcoord)
240  psendeccell%buffMetrics(ibuff+13*ndim) = sfaceedge(ycoord,jcoord)
241  psendeccell%buffMetrics(ibuff+14*ndim) = sfaceedge(zcoord,jcoord)
242 
243  psendeccell%buffMetrics(ibuff+15*ndim) = sfaceedge(xcoord,kcoord)
244  psendeccell%buffMetrics(ibuff+16*ndim) = sfaceedge(ycoord,kcoord)
245  psendeccell%buffMetrics(ibuff+17*ndim) = sfaceedge(zcoord,kcoord)
246 
247  ENDDO ! iFace
248 
249  ENDIF ! iRegSrc
250  ENDDO ! ijk
251 
252 1999 CONTINUE
253  ENDDO ! iEdge
254 
255 ! - Load corners --------------------------------------------------------------
256 
257  DO icorner=1,ncorners
258  IF (.NOT. plevel%cornerCells(icorner)%interact) goto 2999
259 
260 ! -- Bypass for degenerate corner cells ---------------------------------------
261 
262  IF( plevel%cornerCells(icorner)%degenrt /= degenerat_none ) goto 2999
263 
264 ! -- Source region infrastructure ---------------------------------------------
265 
266  DO ijk=1,ubound(plevel%cornerCells(icorner)%cells,1)
267  iregsrc = plevel%cornerCells(icorner)%cells(ijk)%srcRegion
268  IF ( iregsrc == ireg ) THEN
269  ijkccsrc = plevel%cornerCells(icorner)%cells(ijk)%srcCell
270  ndumcellssrc = regions(iregsrc)%nDumCells
271 
272  CALL rflo_getcelloffset( regions(iregsrc),ilev,icoffsrc,ijcoffsrc )
273  CALL getijk( ijkccsrc,icoffsrc,ijcoffsrc,ndumcellssrc, &
274  iccsrc,jccsrc,kccsrc )
275 
276  CALL rflo_getnodeoffset( regions(iregsrc),ilev,inoffsrc,ijnoffsrc )
277  ijkcnsrc = indijk(iccsrc,jccsrc,kccsrc,inoffsrc,ijnoffsrc)
278 
279 ! -- Find face mapping for source region --------------------------------------
280 
281  srcindexmapmat= plevel%cornerCells(icorner)%cells(ijk)%srcIndexMapMat
282 
283  CALL plag_rflo_getfacemapping(srcindexmapmat,srcdir,srcface)
284 
285  idirsrc = srcdir(1); jdirsrc = srcdir(2); kdirsrc = srcdir(3);
286 
287 ! --- Loop over all the Faces -------------------------------------------------
288 ! --- Note: assumption of coordinate alignment between regions removed --------
289 
290  DO iface = 1, nfaces
291  ibuff = ibuff + 1
292 
293  ifacesrc = srcface(iface)
294  SELECT CASE (ifacesrc)
295  CASE(1,3,5)
296  nodecornsrc = indijk(iccsrc,jccsrc,kccsrc,inoffsrc,ijnoffsrc)
297 
298  CASE(2)
299  nodecornsrc = indijk(iccsrc+1,jccsrc,kccsrc,inoffsrc,ijnoffsrc)
300 
301  CASE(4)
302  nodecornsrc = indijk(iccsrc,jccsrc+1,kccsrc,inoffsrc,ijnoffsrc)
303 
304  CASE(6)
305  nodecornsrc = indijk(iccsrc,jccsrc,kccsrc+1,inoffsrc,ijnoffsrc)
306  END SELECT ! iFaceSrc
307 
308 ! --- Determine direction mapping for face normals ----------------------------
309 
310  DO ldir = 1,ndir
311  ldirsrc=srcdir(ldir)
312  SELECT CASE (ldirsrc)
313  CASE(icoord)
314  sfacecorn(xcoord:zcoord,ldirsrc) = psi(xcoord:zcoord,nodecornsrc)
315 
316  CASE(jcoord)
317  sfacecorn(xcoord:zcoord,ldirsrc) = psj(xcoord:zcoord,nodecornsrc)
318 
319  CASE(kcoord)
320  sfacecorn(xcoord:zcoord,ldirsrc) = psk(xcoord:zcoord,nodecornsrc)
321  END SELECT ! ldirSrc
322  ENDDO ! ldir
323 
324 ! --- Load face centroids -----------------------------------------------------
325 
326  psendeccell%buffMetrics(ibuff ) = pfc(xcoord,idirsrc,nodecornsrc)
327  psendeccell%buffMetrics(ibuff+ ndim) = pfc(xcoord,jdirsrc,nodecornsrc)
328  psendeccell%buffMetrics(ibuff+ 2*ndim) = pfc(xcoord,kdirsrc,nodecornsrc)
329 
330  psendeccell%buffMetrics(ibuff+ 3*ndim) = pfc(ycoord,idirsrc,nodecornsrc)
331  psendeccell%buffMetrics(ibuff+ 4*ndim) = pfc(ycoord,jdirsrc,nodecornsrc)
332  psendeccell%buffMetrics(ibuff+ 5*ndim) = pfc(ycoord,kdirsrc,nodecornsrc)
333 
334  psendeccell%buffMetrics(ibuff+ 6*ndim) = pfc(zcoord,idirsrc,nodecornsrc)
335  psendeccell%buffMetrics(ibuff+ 7*ndim) = pfc(zcoord,jdirsrc,nodecornsrc)
336  psendeccell%buffMetrics(ibuff+ 8*ndim) = pfc(zcoord,kdirsrc,nodecornsrc)
337 
338 ! --- Load face normals -------------------------------------------------------
339 
340  psendeccell%buffMetrics(ibuff+ 9*ndim) = sfacecorn(xcoord,icoord)
341  psendeccell%buffMetrics(ibuff+10*ndim) = sfacecorn(ycoord,icoord)
342  psendeccell%buffMetrics(ibuff+11*ndim) = sfacecorn(zcoord,icoord)
343 
344  psendeccell%buffMetrics(ibuff+12*ndim) = sfacecorn(xcoord,jcoord)
345  psendeccell%buffMetrics(ibuff+13*ndim) = sfacecorn(ycoord,jcoord)
346  psendeccell%buffMetrics(ibuff+14*ndim) = sfacecorn(zcoord,jcoord)
347 
348  psendeccell%buffMetrics(ibuff+15*ndim) = sfacecorn(xcoord,kcoord)
349  psendeccell%buffMetrics(ibuff+16*ndim) = sfacecorn(ycoord,kcoord)
350  psendeccell%buffMetrics(ibuff+17*ndim) = sfacecorn(zcoord,kcoord)
351 
352  ENDDO ! iFace
353 
354  ENDIF ! iRegSrc
355  ENDDO ! ijk
356 
357 2999 CONTINUE
358  ENDDO ! iCorner
359 
360 ! Send buffers to destination processor ---------------------------------------
361 
362 #ifdef MPI
363  dest = regions(ir)%procid
364  tag = regions(ir)%localNumber+ plag_tag_shift +mpi_patchoff +10
365  IF(tag .gt. global%mpiTagMax) tag = mod(tag,global%mpiTagMax)
366  CALL mpi_isend( psendeccell%buffMetrics,nbuffsize*ndim,mpi_rfreal, &
367  dest,tag,global%mpiComm, &
368  pplag%requestsMetrics(psendeccell%iRequestMetrics),&
369  global%mpierr )
370  IF ( global%mpierr /= err_none ) &
371  CALL errorstop( global,err_mpi_trouble,__line__ )
372 #endif
373 
374  ENDIF ! some cells to send
375  ENDIF ! not my processor
376  ENDDO ! ir
377 
378 ! finalize
379 
380  CALL deregisterfunction( global )
381 
382 END SUBROUTINE plag_rflo_sendmetrics
383 
384 !******************************************************************************
385 !
386 ! RCS Revision history:
387 !
388 ! $Log: PLAG_RFLO_SendMetrics.F90,v $
389 ! Revision 1.5 2009/03/02 00:19:36 mtcampbe
390 ! Added some ifdefs around Rocflo to disable particle injection on INFLOW
391 ! boundaries and added some checks around MPI tags utilizing a new global
392 ! data item, global%mpiTagMax.
393 !
394 ! Revision 1.4 2008/12/06 08:44:35 mtcampbe
395 ! Updated license.
396 !
397 ! Revision 1.3 2008/11/19 22:17:47 mtcampbe
398 ! Added Illinois Open Source License/Copyright
399 !
400 ! Revision 1.2 2006/04/07 15:19:24 haselbac
401 ! Removed tabs
402 !
403 ! Revision 1.1 2004/12/01 20:58:12 fnajjar
404 ! Initial revision after changing case
405 !
406 ! Revision 1.8 2004/11/29 19:22:39 fnajjar
407 ! Added bypass statement for dengerate cells
408 !
409 ! Revision 1.7 2004/03/21 00:43:32 fnajjar
410 ! Fixed tags to be smaller number since Frost run-time system complains about size
411 !
412 ! Revision 1.6 2004/03/06 21:25:05 fnajjar
413 ! Added PLAG_TAG_SHIFT to MPI-based communication tags
414 !
415 ! Revision 1.5 2004/02/13 01:24:49 fnajjar
416 ! Included missing comma in ModInterfaces calling
417 !
418 ! Revision 1.4 2004/02/11 23:12:35 fnajjar
419 ! Included RFLO_GetNodeOffset in ModInterfaces call
420 !
421 ! Revision 1.3 2004/02/10 21:46:37 fnajjar
422 ! Added capability to remove coordinate alignment between corner-edge regions
423 !
424 ! Revision 1.2 2004/01/28 21:22:07 fnajjar
425 ! Moved statements inside iRegSrc IF loop to fix null state of iRegSrc
426 !
427 ! Revision 1.1 2004/01/15 21:16:48 fnajjar
428 ! Initial import for corner-edge cell metrics
429 !
430 !******************************************************************************
431 
432 
433 
434 
435 
436 
437 
subroutine plag_rflo_getfacemapping(mapMat, srcDir, srcFace)
subroutine rflo_getedgecellsindices(region, iLev, iedge, iebeg, ieend, jebeg, jeend, kebeg, keend)
j indices k indices k
Definition: Indexing.h:6
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
IndexType nedges() const
Definition: Mesh.H:564
subroutine rflo_getnodeoffset(region, iLev, iNodeOffset, ijNodeOffset)
IndexType nfaces() const
Definition: Mesh.H:641
blockLoc i
Definition: read.cpp:79
subroutine rflo_getcelloffset(region, iLev, iCellOffset, ijCellOffset)
**********************************************************************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 icorner
subroutine rflo_getcornercellsindices(region, iLev, icorner, icbeg, icend, jcbeg, jcend, kcbeg, kcend)
**********************************************************************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 icell
j indices j
Definition: Indexing.h:6
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine getijk(ijk, iOffset, ijOffset, nDumCells, i, j, k)
Definition: ModIndexing.F90:54
subroutine plag_rflo_sendmetrics(regions, iReg)