Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_EdgeCellsLoadSendBuff.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: Load buffer data from edge cells.
26 !
27 ! Description: kernel is pertinent when the other region is located
28 ! on a different processor.
29 !
30 ! Input:
31 ! regions = data of all regions
32 ! iReg = current region.
33 ! ir = adjacent region
34 !
35 ! Output:
36 ! buffer data sent for all edges
37 ! nBuffSizeEdge = buffer size for all edges.
38 !
39 ! Notes: none.
40 !
41 !******************************************************************************
42 !
43 ! $Id: PLAG_EdgeCellsLoadSendBuff.F90,v 1.3 2008/12/06 08:44:33 mtcampbe Exp $
44 !
45 ! Copyright: (c) 2004 by the University of Illinois
46 !
47 !******************************************************************************
48 
49 SUBROUTINE plag_edgecellsloadsendbuff( regions,iReg,ir,nBuffSizeEdge )
50 
51  USE moddatatypes
52  USE moderror
53  USE modmpi
54  USE modparameters
55  USE modglobal, ONLY : t_global
56  USE moddatastruct, ONLY : t_dcell, t_dcelltransf, t_region, t_level
57  USE modpartlag, ONLY : t_plag, t_buffer_plag
58 
59  USE plag_modparameters
60 
61  IMPLICIT NONE
62 
63 ! ******************************************************************************
64 ! Definitions and declarations
65 ! ******************************************************************************
66 
67 ! ==============================================================================
68 ! Arguments
69 ! ==============================================================================
70 
71  TYPE(t_region), POINTER :: regions(:)
72 
73  INTEGER, INTENT(IN) :: ir,ireg
74  INTEGER, INTENT(OUT) :: nbuffsizeedge
75 
76 ! ==============================================================================
77 ! Locals
78 ! ==============================================================================
79 
80  CHARACTER(CHRLEN) :: rcsidentstring
81 
82  INTEGER :: i,j,k,icell,iedge,ijk,ilev,iregdes,iregsrc,nedges
83  INTEGER :: iaiv,iarv,iarvold,ibuff,ibuffsendi, ibuffsendr,icont, &
84  icv,icvmass,icvold,irhs,irhssum,ishifti,ishiftr, &
85  narv,naiv,ncont,ncv,ndimi,ndimr,nsendbuffi,nsendbuffr
86 
87  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass,psendbuffi
88  INTEGER, POINTER, DIMENSION(:,:) :: paive, paivolde
89 
90  REAL(RFREAL), POINTER, DIMENSION(:) :: psendbuffr
91  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parve,parvolde,pcve,pcvolde, &
92  prhse,prhssume
93 
94  TYPE(t_buffer_plag), POINTER :: pedgecellsxbuff
95  TYPE(t_dcelltransf), POINTER :: psendeccell
96  TYPE(t_global), POINTER :: global
97  TYPE(t_level), POINTER :: plevelsrc
98  TYPE(t_plag), POINTER :: pplag
99  TYPE(t_region), POINTER :: pregionsrc
100 
101 ! ******************************************************************************
102 ! Start
103 ! ******************************************************************************
104 
105  rcsidentstring = '$RCSfile: PLAG_EdgeCellsLoadSendBuff.F90,v $ $Revision: 1.3 $'
106 
107  global => regions(ireg)%global
108 
109  CALL registerfunction( global,'PLAG_EdgeCellsLoadSendBuff',&
110  'PLAG_EdgeCellsLoadSendBuff.F90' )
111 
112 ! ******************************************************************************
113 ! Get dimensions
114 ! ******************************************************************************
115 
116  ilev = regions(ireg)%currLevel
117  nedges = 12
118 
119  nbuffsizeedge = 0
120 
121 ! ******************************************************************************
122 ! Set pointers
123 ! ******************************************************************************
124 
125  pregionsrc => regions(ireg)
126  plevelsrc => pregionsrc%levels(ilev)
127  pplag => plevelsrc%plag
128  pcvplagmass => pplag%cvPlagMass
129 
130 ! ******************************************************************************
131 ! Set send buffer dimensions
132 ! ******************************************************************************
133 
134  naiv = pplag%nAiv
135  narv = pplag%nArv
136  ncont = pregionsrc%plagInput%nCont
137  ncv = pplag%nCv
138 
139  ndimi = naiv
140  ndimr = 2*narv +4*ncv
141 
142 ! ******************************************************************************
143 ! Load send buffer data
144 ! ******************************************************************************
145 
146  IF ( plevelsrc%sendEcCells(ir)%nCells > 0 ) THEN
147  psendeccell => plevelsrc%sendEcCells(ir)
148  psendbuffi => psendeccell%buffplagI
149  psendbuffr => psendeccell%buffplagR
150 
151 ! =============================================================================
152 ! Loop over edges of source region
153 ! Loading buffer data for edge
154 ! =============================================================================
155 
156  DO iedge=1,nedges
157  IF( .NOT. plevelsrc%edgeCells(iedge)%interact ) goto 2999
158 
159 ! -- Bypass for degenerate edge cells -----------------------------------------
160 
161  IF( plevelsrc%edgeCells(iedge)%degenrt /= degenerat_none ) goto 2999
162 
163  ibuffsendi = 0; ibuffsendr = 0;
164  ishifti = 0; ishiftr = 0;
165 
166  DO ijk=1,ubound(plevelsrc%edgeCells(iedge)%cells,1)
167  iregdes = plevelsrc%edgeCells(iedge)%cells(ijk)%srcRegion
168 
169 !------------------------------------------------------------------------------
170 ! Set pointers
171 !------------------------------------------------------------------------------
172 
173  pedgecellsxbuff => plevelsrc%edgeCells(iedge)%cells(ijk)%bufferExchPlag
174 
175  paive => pedgecellsxbuff%aiv
176  parve => pedgecellsxbuff%arv
177  pcve => pedgecellsxbuff%cv
178  prhse => pedgecellsxbuff%rhs
179  prhssume => pedgecellsxbuff%rhsSum
180 
181  paivolde => pedgecellsxbuff%aivOld
182  parvolde => pedgecellsxbuff%arvOld
183  pcvolde => pedgecellsxbuff%cvOld
184 
185  IF ( iregdes == ir .AND. pedgecellsxbuff%nBuffSize /= 0 .AND. &
186  regions(iregdes)%procid /= global%myProcid ) THEN
187  nbuffsizeedge = nbuffsizeedge +pedgecellsxbuff%nBuffSize
188 
189 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
190 ! Load integer data buffers
191 ! compute shift and accumulate for various edge cells
192 ! provide initial shift to account for multiple particles
193 ! in one cell
194 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
195 
196  DO ibuff = 1, pedgecellsxbuff%nBuffSize
197  ibuffsendi = ishifti +ndimi*(ibuff-1) +1
198  iaiv = ibuffsendi
199 
200  psendbuffi(iaiv ) = paive(aiv_plag_pidini,ibuff)
201  psendbuffi(iaiv+1) = paive(aiv_plag_regini,ibuff)
202  psendbuffi(iaiv+2) = paive(aiv_plag_regcrt,ibuff)
203  psendbuffi(iaiv+3) = paive(aiv_plag_icells,ibuff)
204  psendbuffi(iaiv+4) = paive(aiv_plag_indexi,ibuff)
205  psendbuffi(iaiv+5) = paive(aiv_plag_indexj,ibuff)
206  psendbuffi(iaiv+6) = paive(aiv_plag_indexk,ibuff)
207  psendbuffi(iaiv+7) = paive(aiv_plag_burnstat,ibuff)
208  psendbuffi(iaiv+8) = paive(aiv_plag_status,ibuff)
209 
210 #ifdef PLAG_CECELLS_MPI_DEBUG
211  IF ( ireg==1 ) WRITE(stdout,'(A,A,15(2X,I5))') &
212  ' PLAG_EdgeCellsLoadSendBuff-INT: procSrc, iReg, procDes,',&
213  ' iRegDes,iEdge,ijk,iBuff,iBuffSendI,iShiftI,iAiv = ',&
214  global%myProcid,ireg,ireg,regions(iregdes)%procid,iregdes,iedge, &
215  ijk,ibuff,ibuffsendi,ishifti,iaiv
216 
217  IF(ireg==1) WRITE(stdout,'(A,10(2X,I5))')'iBuff, iAiv,pSendBuffI =',&
218  ibuff,iaiv, &
219  psendbuffi(iaiv ),&
220  psendbuffi(iaiv+1),&
221  psendbuffi(iaiv+2),&
222  psendbuffi(iaiv+3),&
223  psendbuffi(iaiv+4),&
224  psendbuffi(iaiv+5),&
225  psendbuffi(iaiv+6),&
226  psendbuffi(iaiv+7),&
227  psendbuffi(iaiv+8)
228 #endif
229 
230  ENDDO ! iBuff
231 
232 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
233 ! Load real data buffers
234 ! compute shift and accumulate for various edge cells
235 ! provide initial shift to account for multiple particles
236 ! in one cell
237 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
238 
239  DO ibuff = 1, pedgecellsxbuff%nBuffSize
240  ibuffsendr = ishiftr +ndimr*(ibuff-1) +1
241  icv = ibuffsendr
242  irhs = ibuffsendr +ncv
243  irhssum = ibuffsendr +2*ncv
244  icvold = ibuffsendr +3*ncv
245  iarv = ibuffsendr +4*ncv
246  iarvold = ibuffsendr +4*ncv +narv
247 
248 #ifdef PLAG_CECELLS_MPI_DEBUG
249  IF ( ireg==1 ) WRITE(stdout,'(A,10(2X,I5))') &
250  ' PLAG_EdgeCellsLoadSendBuff--REAL:procSrc,iReg,procDes,iBuff,iBuffSendR,iShiftR',&
251  global%myProcid, ireg, regions(iregdes)%procid, iregdes, ibuff, ibuffsendr,ishiftr
252  IF ( ireg==1 ) WRITE(stdout,'(A,A,10(2X,I5))') &
253  ' PLAG_EdgeCellsLoadSendBuff--REAL:procSrc,iReg,procDes,iCv,',&
254  'iRhs,iRhsSum, iCvOld, iArv, iArvOld = ',&
255  global%myProcid, ireg,regions(iregdes)%procid,iregdes,icv, &
256  irhs, irhssum, icvold, iarv, iarvold
257 #endif
258 
259 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
260 ! Load real data buffers: cv
261 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
262 
263  psendbuffr(icv ) = pcve(cv_plag_xmom,ibuff)
264  psendbuffr(icv+1) = pcve(cv_plag_ymom,ibuff)
265  psendbuffr(icv+2) = pcve(cv_plag_zmom,ibuff)
266  psendbuffr(icv+3) = pcve(cv_plag_ener,ibuff)
267  psendbuffr(icv+4) = pcve(cv_plag_xpos,ibuff)
268  psendbuffr(icv+5) = pcve(cv_plag_ypos,ibuff)
269  psendbuffr(icv+6) = pcve(cv_plag_zpos,ibuff)
270  psendbuffr(icv+7) = pcve(cv_plag_enervapor,ibuff)
271  DO icont = 1, ncont
272  icvmass = pcvplagmass(icont)
273  psendbuffr(icv+(cv_plag_last-1)+icont) = pcve(icvmass,ibuff)
274  ENDDO ! iCont
275 
276 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
277 ! Load real data buffers: rhs
278 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
279 
280  psendbuffr(irhs ) = prhse(cv_plag_xmom,ibuff)
281  psendbuffr(irhs+1) = prhse(cv_plag_ymom,ibuff)
282  psendbuffr(irhs+2) = prhse(cv_plag_zmom,ibuff)
283  psendbuffr(irhs+3) = prhse(cv_plag_ener,ibuff)
284  psendbuffr(irhs+4) = prhse(cv_plag_xpos,ibuff)
285  psendbuffr(irhs+5) = prhse(cv_plag_ypos,ibuff)
286  psendbuffr(irhs+6) = prhse(cv_plag_zpos,ibuff)
287  psendbuffr(irhs+7) = prhse(cv_plag_enervapor,ibuff)
288  DO icont = 1, ncont
289  icvmass = pcvplagmass(icont)
290  psendbuffr(irhs+(cv_plag_last-1)+icont) = prhse(icvmass,ibuff)
291  ENDDO ! iCont
292 
293 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
294 ! Load real data buffers: rhsSum
295 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
296 
297  psendbuffr(irhssum ) = prhssume(cv_plag_xmom,ibuff)
298  psendbuffr(irhssum+1) = prhssume(cv_plag_ymom,ibuff)
299  psendbuffr(irhssum+2) = prhssume(cv_plag_zmom,ibuff)
300  psendbuffr(irhssum+3) = prhssume(cv_plag_ener,ibuff)
301  psendbuffr(irhssum+4) = prhssume(cv_plag_xpos,ibuff)
302  psendbuffr(irhssum+5) = prhssume(cv_plag_ypos,ibuff)
303  psendbuffr(irhssum+6) = prhssume(cv_plag_zpos,ibuff)
304  psendbuffr(irhssum+7) = prhssume(cv_plag_enervapor,ibuff)
305  DO icont = 1, ncont
306  icvmass = pcvplagmass(icont)
307  psendbuffr(irhssum+(cv_plag_last-1)+icont) = prhssume(icvmass,ibuff)
308  ENDDO ! iCont
309 
310 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
311 ! Load real data buffers: cvOld
312 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
313 
314  psendbuffr(icvold ) = pcvolde(cv_plag_xmom,ibuff)
315  psendbuffr(icvold+1) = pcvolde(cv_plag_ymom,ibuff)
316  psendbuffr(icvold+2) = pcvolde(cv_plag_zmom,ibuff)
317  psendbuffr(icvold+3) = pcvolde(cv_plag_ener,ibuff)
318  psendbuffr(icvold+4) = pcvolde(cv_plag_xpos,ibuff)
319  psendbuffr(icvold+5) = pcvolde(cv_plag_ypos,ibuff)
320  psendbuffr(icvold+6) = pcvolde(cv_plag_zpos,ibuff)
321  psendbuffr(icvold+7) = pcvolde(cv_plag_enervapor,ibuff)
322  DO icont = 1, ncont
323  icvmass = pcvplagmass(icont)
324  psendbuffr(icvold+(cv_plag_last-1)+icont) = pcvolde(icvmass,ibuff)
325  ENDDO ! iCont
326 
327 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
328 ! Load real data buffers: arv, arvold
329 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
330 
331  psendbuffr(iarv) = parve(arv_plag_spload,ibuff)
332  psendbuffr(iarvold) = parvolde(arv_plag_spload,ibuff)
333 
334 #ifdef PLAG_CECELLS_MPI_DEBUG
335  IF ( ireg==1 ) WRITE(stdout,'(A,A,10(2X,I5))') &
336  ' PLAG_EdgeCellsLoadSendBuff-REAL: procSrc, iReg, procDes,iRegDes,',&
337  'iEdge,iBuff,iBuffSendR,iCv = ',&
338  global%myProcid,ireg,ireg,regions(iregdes)%procid,iregdes,&
339  iedge,ibuff,ibuffsendr,icv
340 
341  IF (ireg==1 ) WRITE(stdout,'(A,2(2X,I5),15(2X,1PE12.5))')'iBuff, iCv,pSendBuffR =',&
342  ibuff,icv, &
343  psendbuffr(icv ),&
344  psendbuffr(icv+1),&
345  psendbuffr(icv+2),&
346  psendbuffr(icv+3),&
347  psendbuffr(icv+4),&
348  psendbuffr(icv+5),&
349  psendbuffr(icv+6),&
350  psendbuffr(icv+7),&
351  psendbuffr(icv+(cv_plag_last-1)+1:icv+(cv_plag_last-1)+ncont)
352 #endif
353 
354  ENDDO ! iBuff
355 
356 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
357 ! Set appropriate shifts for integer and real send buffers
358 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
359 
360  ishifti = ibuffsendi +ndimi -1
361  ishiftr = ibuffsendr +ndimr -1
362 
363  ENDIF ! iRegDes
364  ENDDO ! ijk
365 
366 #ifdef PLAG_CECELLS_MPI_DEBUG
367  IF ( nbuffsizeedge > 0 ) &
368  print*,' PLAG_EdgeCellsLoadSendBuff: procId, iReg, iR, procIdiR, iEdge, nBuffSizeEdge,iRegDes = ',&
369  global%myProcid, ireg, ir, regions(ir)%procid ,iedge, nbuffsizeedge,iregdes
370 #endif
371 
372 2999 CONTINUE
373  ENDDO ! iEdge
374  ENDIF ! some cells to send
375 
376 ! ******************************************************************************
377 ! finalize
378 ! ******************************************************************************
379 
380  CALL deregisterfunction( global )
381 
382 END SUBROUTINE plag_edgecellsloadsendbuff
383 
384 !******************************************************************************
385 !
386 ! RCS Revision history:
387 !
388 ! $Log: PLAG_EdgeCellsLoadSendBuff.F90,v $
389 ! Revision 1.3 2008/12/06 08:44:33 mtcampbe
390 ! Updated license.
391 !
392 ! Revision 1.2 2008/11/19 22:17:46 mtcampbe
393 ! Added Illinois Open Source License/Copyright
394 !
395 ! Revision 1.1 2004/12/01 21:02:42 fnajjar
396 ! Initial revision after changing case
397 !
398 ! Revision 1.3 2004/11/29 19:27:08 fnajjar
399 ! Added bypass statement for dengerate cells
400 !
401 ! Revision 1.2 2004/04/09 23:08:29 fnajjar
402 ! Added AIV_PLAG_STATUS to send buffer
403 !
404 ! Revision 1.1 2004/03/18 21:43:27 fnajjar
405 ! Initial import for MPI-based data buffer communication
406 !
407 !******************************************************************************
408 
409 
410 
411 
412 
413 
414 
k
j indices k indices k
Definition: Indexing.h:6
plag_edgecellsloadsendbuff
subroutine plag_edgecellsloadsendbuff(regions, iReg, ir, nBuffSizeEdge)
Definition: PLAG_EdgeCellsLoadSendBuff.F90:49
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Mesh::GenericCell_2::nedges
IndexType nedges() const
Definition: Mesh.H:564
modpartlag::t_plag
Definition: ModPartLag.F90:124
i
blockLoc i
Definition: read.cpp:79
icell
**********************************************************************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
Definition: RFLO_FindSourceCell.h:27
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
j
j indices j
Definition: Indexing.h:6
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
plag_modparameters
Definition: PLAG_ModParameters.F90:44
modpartlag::t_buffer_plag
Definition: ModPartLag.F90:169