Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_BufferDataRecv.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 from adjacent regions on different processor.
26 !
27 ! Description: none.
28 !
29 ! Input: regions = data of all regions
30 ! iReg = index of current region.
31 !
32 ! Output: integer and real data buffer from other processors.
33 !
34 ! Notes: None.
35 !
36 !******************************************************************************
37 !
38 ! $Id: PLAG_BufferDataRecv.F90,v 1.6 2009/03/02 00:19:36 mtcampbe Exp $
39 !
40 ! Copyright: (c) 2003 by the University of Illinois
41 !
42 !******************************************************************************
43 
44 SUBROUTINE plag_bufferdatarecv( regions, iReg )
45 
46  USE moddatatypes
47  USE modpartlag, ONLY : t_buffer_plag
48  USE modbndpatch, ONLY : t_patch
49  USE moddatastruct, ONLY : t_region
50  USE modglobal, ONLY : t_global
51  USE modpartlag, ONLY : t_plag
52  USE moderror
53  USE modmpi
54  USE modparameters
55  USE plag_modparameters
56 
57  IMPLICIT NONE
58 
59 ! ... parameters
60  TYPE(t_region), POINTER :: regions(:)
61 
62  INTEGER :: ireg
63 
64 ! ... loop variables
65  INTEGER :: ipatch, ibuff, icont
66 
67 ! ... local variables
68  CHARACTER(CHRLEN) :: rcsidentstring
69 
70 #ifdef MPI
71  INTEGER :: statusplag(mpi_status_size)
72 #endif
73 
74  INTEGER :: bctype, ilev, ipatchdes, ipatchsrc, iregsrc, &
75  naiv, narv, nbuffsizedes, ncont, ncv, ndimi, &
76  ndimr, ndv, npatches, nrecvbuffi, nrecvbuffr, &
77  ntv, procdes, procsrc, tagsrci, tagsrcr
78 
79  INTEGER :: iaiv, iarv, iarvold, ibuffrecv, icv, icvold, &
80  irhs, irhssum
81 
82  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass, precvbuffi
83 
84  INTEGER, POINTER, DIMENSION(:,:) :: paivdes, paivolddes
85 
86  REAL(RFREAL), POINTER, DIMENSION(:) :: precvbuffr
87 
88  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parvdes, parvolddes, &
89  pcvdes , pcvolddes , &
90  prhsdes, prhssumdes
91 
92  TYPE(t_patch), POINTER :: ppatchsrc, ppatchdes
93  TYPE(t_plag), POINTER :: pplag
94  TYPE(t_global), POINTER :: global
95 
96 !******************************************************************************
97 
98  rcsidentstring = '$RCSfile: PLAG_BufferDataRecv.F90,v $ $Revision: 1.6 $'
99 
100  global => regions(ireg)%global
101 
102  CALL registerfunction( global,'PLAG_BufferDataRecv',&
103  'PLAG_BufferDataRecv.F90' )
104 
105 ! receive data buffer from source to destination region
106 
107 ! get dimensions --------------------------------------------------------------
108 
109  ncont = regions(ireg)%plagInput%nCont
110  ncv = cv_plag_last + ncont
111  ndv = dv_plag_last
112  ntv = tv_plag_last
113  naiv = aiv_plag_last
114  narv = arv_plag_last
115 
116  ndimi = naiv
117  ndimr = 2*narv +4*ncv
118 
119  ilev = regions(ireg)%currLevel
120  npatches = regions(ireg)%nPatches
121 
122  pplag => regions(ireg)%levels(ilev)%plag
123  pcvplagmass => pplag%cvPlagMass
124 
125 ! loop over patches -----------------------------------------------------------
126 
127  DO ipatch = 1, npatches
128 
129 ! - pointer is at Des region getting data from Src region ---------------------
130 
131  ppatchdes => regions(ireg)%levels(ilev)%patches(ipatch)
132 
133  bctype = ppatchdes%bcType
134  iregsrc = ppatchdes%srcRegion
135  ipatchsrc = ppatchdes%srcPatch
136 
137 ! - region interface for various boundary conditions --------------------------
138 
139  IF ( (bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
140  (bctype>=bc_regionint .AND. bctype<=bc_regionint +bc_range) .OR. &
141  (bctype>=bc_regnonconf .AND. bctype<=bc_regnonconf+bc_range) .OR. &
142  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
143  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range) ) THEN
144 
145  IF ( regions(iregsrc)%procid /= global%myProcid ) THEN
146  ppatchsrc => regions(iregsrc)%levels(ilev)%patches(ipatchsrc)
147 
148  procdes = global%myProcid
149 
150 ! -- set pointers and buffer size on destination region ---------------------------
151 
152  paivdes => ppatchdes%bufferPlag%aiv
153  parvdes => ppatchdes%bufferPlag%arv
154 
155  pcvdes => ppatchdes%bufferPlag%cv
156  prhsdes => ppatchdes%bufferPlag%rhs
157  prhssumdes => ppatchdes%bufferPlag%rhsSum
158 
159  paivolddes => ppatchdes%bufferPlag%aivOld
160  parvolddes => ppatchdes%bufferPlag%arvOld
161  pcvolddes => ppatchdes%bufferPlag%cvOld
162 
163  precvbuffi => ppatchdes%bufferPlag%recvBuffI
164  precvbuffr => ppatchdes%bufferPlag%recvBuffR
165 
166  nbuffsizedes = ppatchdes%bufferPlag%nBuffSizeDes
167 
168 ! -- exit for null buffer size ------------------------------------------------
169 
170  IF ( nbuffsizedes == 0 ) goto 999
171 
172 ! -- set buffer sizes ---------------------------------------------------------
173 
174  nrecvbuffi = ndimi * nbuffsizedes
175  nrecvbuffr = ndimr * nbuffsizedes
176 
177 ! -- receive data -------------------------------------------------------------
178 
179 #ifdef MPI
180 
181  procsrc = regions(iregsrc)%procid
182 
183 ! --- integer -----------------------------------------------------------------
184 
185  tagsrci = regions(ireg)%localNumber &
186  + plag_tag_shift +mpi_patchoff*ppatchsrc%srcPatch*ireg + procdes +1
187 
188  IF(tagsrci .gt. global%mpiTagMax) tagsrci = mod(tagsrci,global%mpiTagMax)
189  CALL mpi_recv( precvbuffi, nrecvbuffi, mpi_integer, &
190  procsrc, tagsrci, global%mpiComm, &
191  statusplag, global%mpierr )
192 
193  IF (global%mpierr /= err_none) &
194  CALL errorstop( global,err_mpi_trouble,__line__ )
195 
196 #ifdef PLAG_MPI_DEBUG
197  IF(nrecvbuffi /=0 ) &
198  WRITE(stdout,*) ' PLAG_BufferDataRecv-INT: iRegDes, iRegSrc, procSrc, tagSrcI, nRecvBuffI = ',&
199  ireg, iregsrc, procsrc,tagsrci, nrecvbuffi
200 #endif
201 
202 ! --- real --------------------------------------------------------------------
203 
204  tagsrcr = regions(ireg)%localNumber &
205  + plag_tag_shift +mpi_patchoff*ppatchsrc%srcPatch*ireg + procdes +2
206 
207  IF(tagsrcr .gt. global%mpiTagMax) tagsrcr = mod(tagsrcr,global%mpiTagMax)
208  CALL mpi_recv( precvbuffr, nrecvbuffr, mpi_rfreal, &
209  procsrc, tagsrcr, global%mpiComm, &
210  statusplag,global%mpierr )
211 
212  IF (global%mpierr /= err_none) &
213  CALL errorstop( global,err_mpi_trouble,__line__ )
214 
215 #ifdef PLAG_MPI_DEBUG
216  IF(nrecvbuffr /=0 ) &
217  WRITE(stdout,*) ' PLAG_BufferDataRecv-REAL: iRegDes, iRegSrc, procSrc, tagSrcR, nRecvBuffR = ',&
218  ireg, iregsrc, procsrc,tagsrcr, nrecvbuffr
219 #endif
220 
221 #endif
222 
223 ! -- copy receive buffers into local arrays -----------------------------------
224 
225 ! --- integer variables -------------------------------------------------------
226 
227  DO ibuff = 1, nbuffsizedes
228 
229 ! ---- compute shift ----------------------------------------------------------
230 
231  ibuffrecv = ndimi*(ibuff-1) +1
232  iaiv = ibuffrecv
233 
234  paivdes(aiv_plag_pidini,ibuff) = precvbuffi(iaiv )
235  paivdes(aiv_plag_regini,ibuff) = precvbuffi(iaiv+1)
236  paivdes(aiv_plag_regcrt,ibuff) = precvbuffi(iaiv+2)
237  paivdes(aiv_plag_icells,ibuff) = precvbuffi(iaiv+3)
238  paivdes(aiv_plag_indexi,ibuff) = precvbuffi(iaiv+4)
239  paivdes(aiv_plag_indexj,ibuff) = precvbuffi(iaiv+5)
240  paivdes(aiv_plag_indexk,ibuff) = precvbuffi(iaiv+6)
241  paivdes(aiv_plag_burnstat,ibuff) = precvbuffi(iaiv+7)
242  paivdes(aiv_plag_status,ibuff) = precvbuffi(iaiv+8)
243 
244  paivolddes(aiv_plag_pidini,ibuff) = precvbuffi(iaiv )
245  paivolddes(aiv_plag_regini,ibuff) = precvbuffi(iaiv+1)
246  paivolddes(aiv_plag_regcrt,ibuff) = precvbuffi(iaiv+2)
247  paivolddes(aiv_plag_icells,ibuff) = precvbuffi(iaiv+3)
248  paivolddes(aiv_plag_indexi,ibuff) = precvbuffi(iaiv+4)
249  paivolddes(aiv_plag_indexj,ibuff) = precvbuffi(iaiv+5)
250  paivolddes(aiv_plag_indexk,ibuff) = precvbuffi(iaiv+6)
251  paivolddes(aiv_plag_burnstat,ibuff) = precvbuffi(iaiv+7)
252  paivolddes(aiv_plag_status,ibuff) = precvbuffi(iaiv+8)
253 
254 #ifdef PLAG_MPI_DEBUG
255  IF(nbuffsizedes /=0 ) &
256  WRITE(stdout,*) ' PLAG_BufferDataRecv-INT: procDes, iBuff, iAiv, pAivDes = ',&
257  procdes, ibuff, iaiv, paivdes(:,ibuff)
258 #endif
259 
260  ENDDO ! iBuff
261 
262 ! --- real variables ----------------------------------------------------------
263 
264  DO ibuff = 1, nbuffsizedes
265 
266 ! ---- compute shifts ---------------------------------------------------------
267 
268  ibuffrecv = ndimr*(ibuff-1) +1
269  icv = ibuffrecv
270  irhs = ibuffrecv +ncv
271  irhssum = ibuffrecv +2*ncv
272  icvold = ibuffrecv +3*ncv
273  iarv = ibuffrecv +4*ncv
274  iarvold = ibuffrecv +4*ncv +narv
275 
276 #ifdef PLAG_MPI_DEBUG
277  IF(nbuffsizedes /=0 ) &
278  WRITE(stdout,*) ' PLAG_BufferDataRecv-REAL: procDes,iBuff, iBuffRecv, iCv, iRhs, iRhsSum, iCvOld, iArv, iArvOld = ',&
279  procdes, ibuff, ibuffrecv,icv, irhs, irhssum, icvold, iarv, iarvold
280 
281  IF(nbuffsizedes /=0 ) &
282  WRITE(stdout,*) ' PLAG_BufferDataRecv-Entering CV:procDes, iReg, iBuff, pRecvBuffR(iCv)', &
283  procdes,ireg, ibuff,precvbuffr(icv:icv+ncv)
284 #endif
285 
286 ! ---- load cv ----------------------------------------------------------------
287 
288  pcvdes(cv_plag_xmom,ibuff) = precvbuffr(icv )
289  pcvdes(cv_plag_ymom,ibuff) = precvbuffr(icv+1)
290  pcvdes(cv_plag_zmom,ibuff) = precvbuffr(icv+2)
291  pcvdes(cv_plag_ener,ibuff) = precvbuffr(icv+3)
292  pcvdes(cv_plag_xpos,ibuff) = precvbuffr(icv+4)
293  pcvdes(cv_plag_ypos,ibuff) = precvbuffr(icv+5)
294  pcvdes(cv_plag_zpos,ibuff) = precvbuffr(icv+6)
295  pcvdes(cv_plag_enervapor,ibuff) = precvbuffr(icv+7)
296  DO icont = 1, ncont
297  pcvdes(pcvplagmass(icont),ibuff) = precvbuffr(icv+(cv_plag_last-1)+icont)
298  ENDDO ! iCont
299 
300 #ifdef PLAG_MPI_DEBUG
301  IF(nbuffsizedes /=0 ) &
302  WRITE(stdout,*) ' PLAG_BufferDataRecv-Done with CV:procDes, iReg, iBuff, pCvDes', &
303  procdes,ireg, ibuff,pcvdes(:,ibuff)
304 #endif
305 
306 ! ---- load rhs ---------------------------------------------------------------
307 
308 
309  prhsdes(cv_plag_xmom,ibuff) = precvbuffr(irhs )
310  prhsdes(cv_plag_ymom,ibuff) = precvbuffr(irhs+1)
311  prhsdes(cv_plag_zmom,ibuff) = precvbuffr(irhs+2)
312  prhsdes(cv_plag_ener,ibuff) = precvbuffr(irhs+3)
313  prhsdes(cv_plag_xpos,ibuff) = precvbuffr(irhs+4)
314  prhsdes(cv_plag_ypos,ibuff) = precvbuffr(irhs+5)
315  prhsdes(cv_plag_zpos,ibuff) = precvbuffr(irhs+6)
316  prhsdes(cv_plag_enervapor,ibuff) = precvbuffr(irhs+7)
317  DO icont = 1, ncont
318  prhsdes(pcvplagmass(icont),ibuff) = precvbuffr(irhs+(cv_plag_last-1)+icont)
319  ENDDO ! iCont
320 
321 #ifdef PLAG_MPI_DEBUG
322  IF(nbuffsizedes /=0 ) &
323  WRITE(stdout,*) ' PLAG_BufferDataRecv-Done with RhsSum:procDes, iReg, iBuff, pRhsDes', &
324  procdes,ireg, ibuff, prhsdes(:,ibuff)
325 #endif
326 
327 ! ---- load rhsSum ------------------------------------------------------------
328 
329 
330  prhssumdes(cv_plag_xmom,ibuff) = precvbuffr(irhssum )
331  prhssumdes(cv_plag_ymom,ibuff) = precvbuffr(irhssum+1)
332  prhssumdes(cv_plag_zmom,ibuff) = precvbuffr(irhssum+2)
333  prhssumdes(cv_plag_ener,ibuff) = precvbuffr(irhssum+3)
334  prhssumdes(cv_plag_xpos,ibuff) = precvbuffr(irhssum+4)
335  prhssumdes(cv_plag_ypos,ibuff) = precvbuffr(irhssum+5)
336  prhssumdes(cv_plag_zpos,ibuff) = precvbuffr(irhssum+6)
337  prhssumdes(cv_plag_enervapor,ibuff) = precvbuffr(irhssum+7)
338  DO icont = 1, ncont
339  prhssumdes(pcvplagmass(icont),ibuff) = precvbuffr(irhssum+(cv_plag_last-1)+icont)
340  ENDDO ! iCont
341 
342 #ifdef PLAG_MPI_DEBUG
343  IF(nbuffsizedes /=0 ) &
344  WRITE(stdout,*) ' PLAG_BufferDataRecv-Done with RhsSum:procDes, iReg, iBuff, pRhsSumDes', &
345  procdes,ireg, ibuff, prhssumdes(:,ibuff)
346 #endif
347 
348 ! ---- load cvOld -------------------------------------------------------------
349 
350 
351  pcvolddes(cv_plag_xmom,ibuff) = precvbuffr(icvold )
352  pcvolddes(cv_plag_ymom,ibuff) = precvbuffr(icvold+1)
353  pcvolddes(cv_plag_zmom,ibuff) = precvbuffr(icvold+2)
354  pcvolddes(cv_plag_ener,ibuff) = precvbuffr(icvold+3)
355  pcvolddes(cv_plag_xpos,ibuff) = precvbuffr(icvold+4)
356  pcvolddes(cv_plag_ypos,ibuff) = precvbuffr(icvold+5)
357  pcvolddes(cv_plag_zpos,ibuff) = precvbuffr(icvold+6)
358  pcvolddes(cv_plag_enervapor,ibuff) = precvbuffr(icvold+7)
359  DO icont = 1, ncont
360  pcvolddes(pcvplagmass(icont),ibuff) = precvbuffr(icvold+(cv_plag_last-1)+icont)
361  ENDDO ! iCont
362 
363 #ifdef PLAG_MPI_DEBUG
364  IF(nbuffsizedes /=0 ) &
365  WRITE(stdout,*) ' PLAG_BufferDataRecv-Done with CVOld:procDes, iReg, iBuff, pCvDes', &
366  procdes,ireg, ibuff,pcvolddes(:,ibuff)
367 #endif
368 
369 ! ---- load arv and arvOld ----------------------------------------------------
370 
371  parvdes(arv_plag_spload,ibuff) = precvbuffr(iarv )
372  parvdes(arv_plag_distot,ibuff) = precvbuffr(iarv+1)
373 
374  parvolddes(arv_plag_spload,ibuff) = precvbuffr(iarvold )
375  parvolddes(arv_plag_distot,ibuff) = precvbuffr(iarvold+1)
376 
377 #ifdef PLAG_MPI_DEBUG
378  IF(nbuffsizedes /=0 ) &
379  WRITE(stdout,*) ' PLAG_BufferDataRecv-Done with Arv:procDes, iReg, iBuff, pArvDes', &
380  procdes,ireg, ibuff,parvdes(:,ibuff),parvolddes(:,ibuff)
381 #endif
382 
383  ENDDO ! iBuff
384 
385  ENDIF ! regions
386  ENDIF ! bcType
387 
388 999 CONTINUE
389 
390  ENDDO ! iPatch
391 
392 ! finalize --------------------------------------------------------------------
393 
394  CALL deregisterfunction( global )
395 
396 END SUBROUTINE plag_bufferdatarecv
397 
398 !******************************************************************************
399 !
400 ! RCS Revision history:
401 !
402 ! $Log: PLAG_BufferDataRecv.F90,v $
403 ! Revision 1.6 2009/03/02 00:19:36 mtcampbe
404 ! Added some ifdefs around Rocflo to disable particle injection on INFLOW
405 ! boundaries and added some checks around MPI tags utilizing a new global
406 ! data item, global%mpiTagMax.
407 !
408 ! Revision 1.5 2008/12/06 08:44:32 mtcampbe
409 ! Updated license.
410 !
411 ! Revision 1.4 2008/11/19 22:17:45 mtcampbe
412 ! Added Illinois Open Source License/Copyright
413 !
414 ! Revision 1.3 2006/04/07 15:19:23 haselbac
415 ! Removed tabs
416 !
417 ! Revision 1.2 2005/05/31 21:37:31 fnajjar
418 ! Added ARV_PLAG_DISTOT for proper IO capabilities
419 !
420 ! Revision 1.1 2004/12/01 20:56:55 fnajjar
421 ! Initial revision after changing case
422 !
423 ! Revision 1.7 2004/04/09 23:04:12 fnajjar
424 ! Added AIV_PLAG_STATUS to buffers being sent and received
425 !
426 ! Revision 1.6 2004/03/21 00:43:32 fnajjar
427 ! Fixed tags to be smaller number since Frost run-time system complains about size
428 !
429 ! Revision 1.5 2004/03/12 23:41:46 fnajjar
430 ! Bug fix for pRhsSumDes with incorrect assignment
431 !
432 ! Revision 1.4 2004/03/06 21:25:05 fnajjar
433 ! Added PLAG_TAG_SHIFT to MPI-based communication tags
434 !
435 ! Revision 1.3 2004/02/13 23:22:07 fnajjar
436 ! Included new cv and aiv definitions for particle burning module
437 !
438 ! Revision 1.2 2003/05/13 15:02:13 fnajjar
439 ! Added IFDEF clause around WRITE statement
440 !
441 ! Revision 1.1 2003/02/21 17:08:48 fnajjar
442 ! Initial import
443 !
444 !******************************************************************************
445 
446 
447 
448 
449 
450 
451 
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
modpartlag::t_plag
Definition: ModPartLag.F90:124
plag_bufferdatarecv
subroutine plag_bufferdatarecv(regions, iReg)
Definition: PLAG_BufferDataRecv.F90:44
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
modbndpatch::t_patch
Definition: ModBndPatch.F90:91