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