Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_CECellsRecvData.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: receive buffer data to edge and corner cells of an adjacent region.
26 ! and append Lagrangian particle datastructure from buffers
27 ! communicated via the corner and edge cell infrastructure.
28 !
29 ! Description: kernel is pertinent when the other region is located
30 ! on a different processor.
31 !
32 ! Input:
33 ! regions = data of all regions
34 ! iReg = current region.
35 !
36 ! Output: buffer size received.
37 !
38 ! Notes: none.
39 !
40 !******************************************************************************
41 !
42 ! $Id: PLAG_CECellsRecvData.F90,v 1.5 2009/03/02 00:19:36 mtcampbe Exp $
43 !
44 ! Copyright: (c) 2004 by the University of Illinois
45 !
46 !******************************************************************************
47 
48 SUBROUTINE plag_cecellsrecvdata( regions,iReg )
49 
50  USE moddatatypes
51  USE moderror
52  USE modmpi
53  USE modparameters
54  USE modglobal, ONLY : t_global
55  USE moddatastruct, ONLY : t_dcelltransf, t_level, t_region
56  USE modpartlag, ONLY : t_plag,t_buffer_plag
57 
58  USE plag_modparameters
59 
60  IMPLICIT NONE
61 
62 ! ******************************************************************************
63 ! Definitions and declarations
64 ! ******************************************************************************
65 
66 ! ==============================================================================
67 ! Arguments
68 ! ==============================================================================
69 
70  TYPE(t_region), POINTER :: regions(:)
71 
72  INTEGER, INTENT(IN) :: ireg
73 
74 ! ==============================================================================
75 ! Locals
76 ! ==============================================================================
77 
78  CHARACTER(CHRLEN) :: rcsidentstring
79 
80 #ifdef MPI
81  INTEGER :: statusplag(mpi_status_size)
82 #endif
83 
84  INTEGER :: iaiv,iarv,iarvold,ibuff,ibuffsendi,ibuffsendr,icont,icv, &
85  icvmass,icvold,ilev,ipcl,ipclbeg,ipclend,ir,irhs,irhssum,&
86  source,tagi,tagr
87  INTEGER :: narv,naiv,nbuffsizerecv,ncont,ncv,ndimi,ndimr,npcls,npclsprev, &
88  nrecvbuffi,nrecvbuffr
89  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass, precvbuffi
90 
91  INTEGER, POINTER, DIMENSION(:,:) :: paiv, paivold
92 
93  REAL(RFREAL), POINTER, DIMENSION(:) :: precvbuffr
94 
95  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv,parvold,pcv,pcvold ,&
96  prhs,prhssum
97 
98  TYPE(t_dcelltransf), POINTER :: precveccell
99  TYPE(t_global), POINTER :: global
100  TYPE(t_level), POINTER :: plevel
101  TYPE(t_plag), POINTER :: pplag
102  TYPE(t_region), POINTER :: pregion
103 
104 ! ******************************************************************************
105 ! Start
106 ! ******************************************************************************
107 
108  rcsidentstring = '$RCSfile: PLAG_CECellsRecvData.F90,v $ $Revision: 1.5 $'
109 
110  global => regions(ireg)%global
111 
112  CALL registerfunction( global,'PLAG_CECellsRecvData',&
113  'PLAG_CECellsRecvData.F90' )
114 
115 ! ******************************************************************************
116 ! Set pointers
117 ! ******************************************************************************
118 
119  ilev = regions(ireg)%currLevel
120 
121  pregion => regions(ireg)
122  plevel => regions(ireg)%levels(ilev)
123  pplag => plevel%plag
124 
125  pcvplagmass => pplag%cvPlagMass
126 
127  paiv => pplag%aiv
128 
129  parv => pplag%arv
130  pcv => pplag%cv
131  prhs => pplag%rhs
132  prhssum => pplag%rhsSum
133 
134  paivold => pplag%aivOld
135  parvold => pplag%arvOld
136  pcvold => pplag%cvOld
137 
138 ! ******************************************************************************
139 ! Get dimensions
140 ! ******************************************************************************
141 
142  ncont = regions(ireg)%plagInput%nCont
143 
144  naiv = pplag%nAiv
145  narv = pplag%nArv
146  ncv = pplag%nCv
147 
148  ndimi = naiv
149  ndimr = 2*narv +4*ncv
150 
151 ! ******************************************************************************
152 ! Receive buffer data from source processor
153 ! ******************************************************************************
154 
155  DO ir=1,global%nRegions
156  IF (regions(ir)%procid == global%myProcid) goto 999
157 
158  IF (plevel%recvEcCells(ir)%nCells > 0) THEN
159  precveccell => plevel%recvEcCells(ir)
160  precvbuffi => precveccell%buffplagI
161  precvbuffr => precveccell%buffplagR
162 
163 ! =============================================================================
164 ! Bypass MPI communication for null buffer size
165 ! =============================================================================
166 
167  nbuffsizerecv = precveccell%nBuffSizePlag
168 
169  IF ( nbuffsizerecv == 0 ) goto 1999
170 
171 ! =============================================================================
172 ! Set receive buffer sizes
173 ! =============================================================================
174 
175  nrecvbuffi = ndimi * nbuffsizerecv
176  nrecvbuffr = ndimr * nbuffsizerecv
177  ibuffsendi = 0
178  ibuffsendr = 0
179 
180 #ifdef MPI
181  source = regions(ir)%procid
182 
183 ! =============================================================================
184 ! Integer buffer data
185 ! =============================================================================
186 
187  tagi = regions(ireg)%localNumber +plag_tag_shift +mpi_patchoff +2000
188  IF(tagi .gt. global%mpiTagMax) tagi = mod(tagi,global%mpiTagMax)
189 
190  CALL mpi_recv( precvbuffi,nrecvbuffi,mpi_integer, &
191  source,tagi,global%mpiComm,statusplag,global%mpierr )
192  IF ( global%mpierr /= err_none ) &
193  CALL errorstop( global,err_mpi_trouble,__line__ )
194 
195 #ifdef PLAG_CECELLS_MPI_DEBUG
196  WRITE(stdout,'(A,6(2X,I5))') &
197  ' PLAG_CECellsRecvData-INT: iRegDes, iRegSrc, procSrc, tagSrc, nBuffSizeRecv, nRecvBuffI = ',&
198  ireg, ir,source,tagi,nbuffsizerecv,nrecvbuffi
199 #endif
200 
201 ! =============================================================================
202 ! Real buffer data
203 ! =============================================================================
204 
205  tagr = regions(ireg)%localNumber +plag_tag_shift +mpi_patchoff +3000
206 
207  IF(tagr .gt. global%mpiTagMax) tagr = mod(tagr,global%mpiTagMax)
208 
209  CALL mpi_recv( precvbuffr,nrecvbuffr,mpi_rfreal, &
210  source,tagr,global%mpiComm,statusplag,global%mpierr )
211  IF ( global%mpierr /= err_none ) &
212  CALL errorstop( global,err_mpi_trouble,__line__ )
213 
214 #ifdef PLAG_CECELLS_MPI_DEBUG
215  WRITE(stdout,'(A,6(2X,I5))') &
216  ' PLAG_CECellsRecvSize-REAL: iRegDes, iRegSrc, procSrc, tagSrc, nBuffSizeRecv, nRecvBuffR = ',&
217  ireg, ir,source,tagr,nbuffsizerecv,nrecvbuffr
218 #endif
219 #endif
220 
221 #ifdef PLAG_CECELLS_MPI_DEBUG
222  IF ( nbuffsizerecv > 0 ) THEN
223  DO ibuff=1,nbuffsizerecv
224  ibuffsendi = ndimi*(ibuff-1) +1
225  iaiv = ibuffsendi
226 
227  print*,'iBuff,iBuffSendI,iAiv,pRecvBuffI = ',&
228  ibuff,ibuffsendi,iaiv,&
229  precvbuffi(iaiv ),precvbuffi(iaiv+1),precvbuffi(iaiv+2),&
230  precvbuffi(iaiv+3),precvbuffi(iaiv+4),precvbuffi(iaiv+5),&
231  precvbuffi(iaiv+6),precvbuffi(iaiv+7)
232 
233  ibuffsendr = ndimr*(ibuff-1) +1
234  icv = ibuffsendr
235  irhs = ibuffsendr +ncv
236  irhssum = ibuffsendr +2*ncv
237  icvold = ibuffsendr +3*ncv
238  iarv = ibuffsendr +4*ncv
239  iarvold = ibuffsendr +4*ncv +narv
240 
241  print*,'iBuff,iBuffSendR,iCv,pRecvBuffR = ',&
242  ibuff,icv,&
243  precvbuffr(icv ),precvbuffr(icv+1),precvbuffr(icv+2),&
244  precvbuffr(icv+3),precvbuffr(icv+4),precvbuffr(icv+5),&
245  precvbuffr(icv+6),precvbuffr(icv+7),precvbuffr(icv+(cv_plag_last-1)+1:icv+(cv_plag_last-1)+ncont)
246 
247  END DO ! iBuff
248  ENDIF ! nBuffSizeRecv
249 #endif
250 
251 ! =============================================================================
252 ! Append data from buffers to PLAG datastructure
253 ! =============================================================================
254 
255 !------------------------------------------------------------------------------
256 ! Set loop extent
257 !------------------------------------------------------------------------------
258 
259  npcls = pplag%nPcls
260  npclsprev = npcls
261 
262  ipclbeg = npcls +1
263  ipclend = ipclbeg +(nbuffsizerecv-1)
264 
265  ibuffsendi = 0
266  ibuffsendr = 0
267 
268 !------------------------------------------------------------------------------
269 ! Append to PLAG datastructure with receive buffer arrays
270 !------------------------------------------------------------------------------
271 
272  DO ipcl = ipclbeg,ipclend
273  ibuff = ipcl-ipclbeg+1
274 
275 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
276 ! Load aiv from integer data buffers
277 ! compute shift and accumulate for various edge cells
278 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
279 
280  ibuffsendi = ndimi*(ibuff-1) +1
281  iaiv = ibuffsendi
282 
283 ! pAiv(:,iPcl) = pRecvBuffI(: )
284 
285  paiv(aiv_plag_pidini,ipcl) = precvbuffi(iaiv )
286  paiv(aiv_plag_regini,ipcl) = precvbuffi(iaiv+1)
287  paiv(aiv_plag_regcrt,ipcl) = precvbuffi(iaiv+2)
288  paiv(aiv_plag_icells,ipcl) = precvbuffi(iaiv+3)
289  paiv(aiv_plag_indexi,ipcl) = precvbuffi(iaiv+4)
290  paiv(aiv_plag_indexj,ipcl) = precvbuffi(iaiv+5)
291  paiv(aiv_plag_indexk,ipcl) = precvbuffi(iaiv+6)
292  paiv(aiv_plag_burnstat,ipcl) = precvbuffi(iaiv+7)
293  paiv(aiv_plag_status,ipcl) = precvbuffi(iaiv+8)
294 
295  paivold(1:naiv,ipcl) = paiv(1:naiv,ipcl)
296 
297 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
298 ! Load from real data buffers
299 ! compute shift and accumulate for various edge cells
300 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
301 
302  ibuffsendr = ndimr*(ibuff-1) +1
303  icv = ibuffsendr
304  irhs = ibuffsendr +ncv
305  irhssum = ibuffsendr +2*ncv
306  icvold = ibuffsendr +3*ncv
307  iarv = ibuffsendr +4*ncv
308  iarvold = ibuffsendr +4*ncv +narv
309 
310 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
311 ! Load real data buffers: cv
312 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
313 
314  pcv(cv_plag_xmom,ipcl) = precvbuffr(icv )
315  pcv(cv_plag_ymom,ipcl) = precvbuffr(icv+1)
316  pcv(cv_plag_zmom,ipcl) = precvbuffr(icv+2)
317  pcv(cv_plag_ener,ipcl) = precvbuffr(icv+3)
318  pcv(cv_plag_xpos,ipcl) = precvbuffr(icv+4)
319  pcv(cv_plag_ypos,ipcl) = precvbuffr(icv+5)
320  pcv(cv_plag_zpos,ipcl) = precvbuffr(icv+6)
321  pcv(cv_plag_enervapor,ipcl) = precvbuffr(icv+7)
322  DO icont = 1, ncont
323  icvmass = pcvplagmass(icont)
324  pcv(icvmass,ipcl) = precvbuffr(icv+(cv_plag_last-1)+icont)
325  ENDDO ! iCont
326 
327 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
328 ! Load real data buffers: rhs
329 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
330 
331  prhs(cv_plag_xmom,ipcl) = precvbuffr(irhs )
332  prhs(cv_plag_ymom,ipcl) = precvbuffr(irhs+1)
333  prhs(cv_plag_zmom,ipcl) = precvbuffr(irhs+2)
334  prhs(cv_plag_ener,ipcl) = precvbuffr(irhs+3)
335  prhs(cv_plag_xpos,ipcl) = precvbuffr(irhs+4)
336  prhs(cv_plag_ypos,ipcl) = precvbuffr(irhs+5)
337  prhs(cv_plag_zpos,ipcl) = precvbuffr(irhs+6)
338  prhs(cv_plag_enervapor,ipcl)= precvbuffr(irhs+7)
339  DO icont = 1, ncont
340  icvmass = pcvplagmass(icont)
341  prhs(icvmass,ipcl) = precvbuffr(irhs+(cv_plag_last-1)+icont)
342  ENDDO ! iCont
343 
344 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
345 ! Load real data buffers: rhsSum
346 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
347 
348  prhssum(cv_plag_xmom,ipcl) = precvbuffr(irhssum )
349  prhssum(cv_plag_ymom,ipcl) = precvbuffr(irhssum+1)
350  prhssum(cv_plag_zmom,ipcl) = precvbuffr(irhssum+2)
351  prhssum(cv_plag_ener,ipcl) = precvbuffr(irhssum+3)
352  prhssum(cv_plag_xpos,ipcl) = precvbuffr(irhssum+4)
353  prhssum(cv_plag_ypos,ipcl) = precvbuffr(irhssum+5)
354  prhssum(cv_plag_zpos,ipcl) = precvbuffr(irhssum+6)
355  prhssum(cv_plag_enervapor,ipcl) = precvbuffr(irhssum+7)
356  DO icont = 1, ncont
357  icvmass = pcvplagmass(icont)
358  prhssum(icvmass,ipcl) = precvbuffr(irhssum+(cv_plag_last-1)+icont)
359  ENDDO ! iCont
360 
361 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
362 ! Load real data buffers: cvOld
363 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
364 
365  pcvold(cv_plag_xmom,ipcl) = precvbuffr(icvold )
366  pcvold(cv_plag_ymom,ipcl) = precvbuffr(icvold+1)
367  pcvold(cv_plag_zmom,ipcl) = precvbuffr(icvold+2)
368  pcvold(cv_plag_ener,ipcl) = precvbuffr(icvold+3)
369  pcvold(cv_plag_xpos,ipcl) = precvbuffr(icvold+4)
370  pcvold(cv_plag_ypos,ipcl) = precvbuffr(icvold+5)
371  pcvold(cv_plag_zpos,ipcl) = precvbuffr(icvold+6)
372  pcvold(cv_plag_enervapor,ipcl) = precvbuffr(icvold+7)
373  DO icont = 1, ncont
374  icvmass = pcvplagmass(icont)
375  pcvold(icvmass,ipcl) = precvbuffr(icvold+(cv_plag_last-1)+icont)
376  ENDDO ! iCont
377 
378 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
379 ! Load real data buffers: arv, arvold
380 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
381 
382  parv(arv_plag_spload,ipcl) = precvbuffr(iarv)
383  parvold(arv_plag_spload,ipcl) = precvbuffr(iarvold)
384  END DO ! iPcl
385 
386 ! =============================================================================
387 ! Get new particle datasize
388 ! =============================================================================
389 
390  npcls = npcls +nbuffsizerecv
391  pplag%nPcls = npcls
392 
393 #ifdef PLAG_CECELLS_MPI_DEBUG
394  IF ( nbuffsizerecv > 0 ) THEN
395  WRITE(stdout,'(A,A,2X,1PE15.7,2X,3(I3,2X),5(I4,3X))') &
396  ' PLAG_CECellsRecvData: time, procId,iReg, nBuffSizeRecv, ',&
397  ' nPcls,nPclsPrev,iPclBeg,iPclEnd = ',&
398  global%currentTime+global%dtMin,ireg,global%myProcid, &
399  nbuffsizerecv,npcls,npclsprev,ipclbeg,ipclend
400  DO ipcl=1,npcls
401  print*,'iPcl,aiv = ',&
402  ipcl,&
403  paiv(aiv_plag_pidini,ipcl),&
404  paiv(aiv_plag_regini,ipcl),&
405  paiv(aiv_plag_regcrt,ipcl),&
406  paiv(aiv_plag_icells,ipcl),&
407  paiv(aiv_plag_indexi,ipcl),&
408  paiv(aiv_plag_indexj,ipcl),&
409  paiv(aiv_plag_indexk,ipcl),&
410  paiv(aiv_plag_burnstat,ipcl),&
411  paiv(aiv_plag_status,ipcl)
412  END DO ! iPcl
413  DO ipcl=1,npcls
414  print*,'iPcl,cv = ',&
415  ipcl,&
416  pcv(cv_plag_xmom,ipcl),&
417  pcv(cv_plag_ymom,ipcl),&
418  pcv(cv_plag_zmom,ipcl),&
419  pcv(cv_plag_ener,ipcl),&
420  pcv(cv_plag_xpos,ipcl),&
421  pcv(cv_plag_ypos,ipcl),&
422  pcv(cv_plag_zpos,ipcl),&
423  pcv(cv_plag_enervapor,ipcl),&
424  pcv(cv_plag_last+1:cv_plag_last+ncont,ipcl)
425  END DO ! iPcl
426  ENDIF ! nBuffSizeRecv
427 #endif
428 
429 1999 CONTINUE
430  ENDIF ! some cells to receive
431 
432 999 CONTINUE
433  ENDDO ! ir
434 
435 ! ******************************************************************************
436 ! finalize
437 ! ******************************************************************************
438 
439  CALL deregisterfunction( global )
440 
441 END SUBROUTINE plag_cecellsrecvdata
442 
443 !******************************************************************************
444 !
445 ! RCS Revision history:
446 !
447 ! $Log: PLAG_CECellsRecvData.F90,v $
448 ! Revision 1.5 2009/03/02 00:19:36 mtcampbe
449 ! Added some ifdefs around Rocflo to disable particle injection on INFLOW
450 ! boundaries and added some checks around MPI tags utilizing a new global
451 ! data item, global%mpiTagMax.
452 !
453 ! Revision 1.4 2008/12/06 08:44:33 mtcampbe
454 ! Updated license.
455 !
456 ! Revision 1.3 2008/11/19 22:17:45 mtcampbe
457 ! Added Illinois Open Source License/Copyright
458 !
459 ! Revision 1.2 2006/04/07 15:19:23 haselbac
460 ! Removed tabs
461 !
462 ! Revision 1.1 2004/12/01 20:57:15 fnajjar
463 ! Initial revision after changing case
464 !
465 ! Revision 1.2 2004/04/09 23:06:50 fnajjar
466 ! Added AIV_PLAG_STATUS to receive buffer
467 !
468 ! Revision 1.1 2004/03/18 21:43:27 fnajjar
469 ! Initial import for MPI-based data buffer communication
470 !
471 !******************************************************************************
472 
473 
474 
475 
476 
477 
478 
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
plag_cecellsrecvdata
subroutine plag_cecellsrecvdata(regions, iReg)
Definition: PLAG_CECellsRecvData.F90:48
modpartlag::t_plag
Definition: ModPartLag.F90:124
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
Ray_2::source
CGAL::Point_2< R > source() const
Definition: Ray_2.h:128
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
plag_modparameters
Definition: PLAG_ModParameters.F90:44
modpartlag::t_buffer_plag
Definition: ModPartLag.F90:169