Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_CECellsAllocateData.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: allocate memory for variables associated with buffer datastructure
26 ! of the corner and edge cells for all active regions.
27 !
28 ! Description: none.
29 !
30 ! Input: regions = all regions,
31 ! iReg = region number.
32 !
33 ! Output: region%level%cornerCells(:)%bufferExchPlag = corner cell buffers
34 ! region%level%edgeCells(:)%bufferExchPlag = edge cell buffers
35 !
36 ! Notes: an improved kernel is to determine the maximum buffer sizes
37 ! of all the regions and use that value to allocate the arrays.
38 !
39 !******************************************************************************
40 !
41 ! $Id: PLAG_CECellsAllocateData.F90,v 1.3 2008/12/06 08:44:32 mtcampbe Exp $
42 !
43 ! Copyright: (c) 2003 by the University of Illinois
44 !
45 !******************************************************************************
46 
47 SUBROUTINE plag_cecellsallocatedata( regions, iReg )
48 
49  USE moddatatypes
50  USE modpartlag, ONLY : t_plag, t_plag_input, t_buffer_plag
51  USE moddatastruct, ONLY : t_region, t_level
52  USE modglobal, ONLY : t_global
53  USE moderror
54  USE modparameters
55  USE plag_modparameters
56  USE modmpi
57 
58  IMPLICIT NONE
59 
60 ! ... parameters
61  TYPE(t_region), POINTER :: regions(:)
62 
63  INTEGER, INTENT(IN) :: ireg
64 
65 ! ... loop variables
66  INTEGER :: icorner, iedge, ilev, ijk
67 
68 ! ... local variables
69  CHARACTER(CHRLEN) :: rcsidentstring
70 
71  INTEGER :: errorflag, naiv, narv, ncont, ncv, ndv, ntv
72  INTEGER :: nbuffi, nbuffr, nbuffsizemax, ngridlevels
73  INTEGER :: nbuffsizecorn, nbuffsizeedge
74 
75  TYPE(t_region), POINTER :: pregion
76  TYPE(t_level), POINTER :: plevel
77  TYPE(t_buffer_plag), POINTER :: pcorncellsxbuff, pedgecellsxbuff
78  TYPE(t_plag), POINTER :: pplag
79  TYPE(t_global), POINTER :: global
80 
81 !******************************************************************************
82 
83  rcsidentstring = '$RCSfile: PLAG_CECellsAllocateData.F90,v $ $Revision: 1.3 $'
84 
85  global => regions(ireg)%global
86 
87  CALL registerfunction( global, 'PLAG_CECellsAllocateData',&
88  'PLAG_CECellsAllocateData.F90' )
89 
90  IF ( global%myProcid == masterproc .AND. &
91  global%verbLevel > verbose_none ) THEN
92  WRITE(stdout,'(A,3X,A)') solver_name, &
93  'Allocating Corner-Edge Cells Data Buffers for PLAG...'
94  END IF ! global%verbLevel
95 
96 ! Set pointer -----------------------------------------------------------------
97 
98  pregion => regions(ireg)
99 
100 ! Get dimensions --------------------------------------------------------------
101 
102  ncont = pregion%plagInput%nCont
103  nbuffsizemax = pregion%plagInput%nPclsBuffCECellsMax
104  ngridlevels = pregion%nGridLevels
105  nbuffsizecorn = nbuffsizemax
106  nbuffsizeedge = nbuffsizemax
107 
108 ! Loop over all grid levels ---------------------------------------------------
109 
110  DO ilev=1,ngridlevels
111 
112 ! - Set pointers --------------------------------------------------------------
113 
114  plevel => pregion%levels(ilev)
115  pplag => regions(ireg)%levels(ilev)%plag
116 
117 ! - Get dimensions ------------------------------------------------------------
118 
119  naiv = pplag%nAiv
120  narv = pplag%nArv
121 
122  ncv = pplag%nCv
123  ndv = pplag%nDv
124  ntv = pplag%nTv
125 
126  nbuffi = 2*naiv
127  nbuffr = 2*narv +4*ncv +ndv +ntv
128 
129 ! - Corner cells --------------------------------------------------------------
130 
131 ! - Initialize buffer size for all corner cells -------------------------------
132 
133  DO icorner=1,8
134 
135 ! -- Bypass for noninteracting regions ----------------------------------------
136 
137  IF( .NOT. plevel%cornerCells(icorner)%interact ) goto 1999
138 
139 ! -- Set pointer --------------------------------------------------------------
140 
141  DO ijk=1,ubound(plevel%cornerCells(icorner)%cells,1)
142  pcorncellsxbuff => plevel%cornerCells(icorner)%cells(ijk)%bufferExchPlag
143  pcorncellsxbuff%nBuffSize = 0
144  pcorncellsxbuff%nBuffSizeDes = 0
145  ENDDO ! ijk
146 
147 1999 CONTINUE
148  ENDDO ! iCorner
149 
150 ! - Allocate buffer arrays only for non-degenerate corner cells ---------------
151 
152  DO icorner=1,8
153 
154 ! -- Bypass for noninteracting regions ----------------------------------------
155 
156  IF( .NOT. plevel%cornerCells(icorner)%interact ) goto 2999
157 
158 ! -- Bypass for degenerate corner cells ---------------------------------------
159 
160  IF( plevel%cornerCells(icorner)%degenrt /= degenerat_none ) goto 2999
161 
162 ! -- Set pointer --------------------------------------------------------------
163 
164  DO ijk=1,ubound(plevel%cornerCells(icorner)%cells,1)
165  pcorncellsxbuff => plevel%cornerCells(icorner)%cells(ijk)%bufferExchPlag
166 
167  pcorncellsxbuff%nBuffSizeTot = nbuffsizecorn
168 
169 ! -- Allocate buffer data -----------------------------------------------------
170 
171  ALLOCATE( pcorncellsxbuff%aiv(naiv,nbuffsizecorn),stat=errorflag )
172  global%error = errorflag
173  IF (global%error /= err_none) THEN
174  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%aiv' )
175  END IF ! global%error
176 
177  ALLOCATE( pcorncellsxbuff%arv(narv,nbuffsizecorn),stat=errorflag )
178  global%error = errorflag
179  IF (global%error /= err_none) THEN
180  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%arv' )
181  END IF ! global%error
182 
183  ALLOCATE( pcorncellsxbuff%cv(ncv,nbuffsizecorn),stat=errorflag )
184  global%error = errorflag
185  IF (global%error /= err_none) THEN
186  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%cv' )
187  END IF ! global%error
188 
189  ALLOCATE( pcorncellsxbuff%dv(ndv,nbuffsizecorn),stat=errorflag )
190  global%error = errorflag
191  IF (global%error /= err_none) THEN
192  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%dv' )
193  END IF ! global%error
194 
195  ALLOCATE( pcorncellsxbuff%tv(ntv,nbuffsizecorn),stat=errorflag )
196  global%error = errorflag
197  IF (global%error /= err_none) THEN
198  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%tv' )
199  END IF ! global%error
200 
201  ALLOCATE( pcorncellsxbuff%aivOld(naiv,nbuffsizecorn),stat=errorflag )
202  global%error = errorflag
203  IF (global%error /= err_none) THEN
204  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%aivOld' )
205  END IF ! global%error
206 
207  ALLOCATE( pcorncellsxbuff%arvOld(narv,nbuffsizecorn),stat=errorflag )
208  global%error = errorflag
209  IF (global%error /= err_none) THEN
210  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%arvOld' )
211  END IF ! global%error
212 
213  ALLOCATE( pcorncellsxbuff%cvOld(ncv,nbuffsizecorn),stat=errorflag )
214  global%error = errorflag
215  IF (global%error /= err_none) THEN
216  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%cvOld' )
217  END IF ! global%error
218 
219  ALLOCATE( pcorncellsxbuff%rhs(ncv,nbuffsizecorn),stat=errorflag )
220  global%error = errorflag
221  IF (global%error /= err_none) THEN
222  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%rhs' )
223  END IF ! global%error
224 
225  ALLOCATE( pcorncellsxbuff%rhsSum(ncv,nbuffsizecorn),stat=errorflag )
226  global%error = errorflag
227  IF (global%error /= err_none) THEN
228  CALL errorstop( global, err_allocate,__line__,'pCornCellsXBuff%rhsSum' )
229  END IF ! global%error
230 
231 ! -- Initialize data --------------------------------------------------------
232 
233  pcorncellsxbuff%aiv = 0
234  pcorncellsxbuff%arv = 0.0_rfreal
235  pcorncellsxbuff%cv = 0.0_rfreal
236  pcorncellsxbuff%dv = 0.0_rfreal
237  pcorncellsxbuff%tv = 0.0_rfreal
238 
239  pcorncellsxbuff%aivOld = 0
240  pcorncellsxbuff%arvOld = 0.0_rfreal
241  pcorncellsxbuff%cvOld = 0.0_rfreal
242 
243  pcorncellsxbuff%rhs = 0.0_rfreal
244  pcorncellsxbuff%rhsSum = 0.0_rfreal
245  ENDDO ! ijk
246 
247 2999 CONTINUE
248 
249  ENDDO ! iCorner
250 
251 ! - Edge cells ----------------------------------------------------------------
252 
253 ! - Initialize buffer size for all corner cells -------------------------------
254 
255  DO iedge=1,12
256 
257 ! -- Bypass for noninteracting regions ----------------------------------------
258 
259  IF( .NOT. plevel%edgeCells(iedge)%interact ) goto 3999
260 
261 ! -- Set pointer --------------------------------------------------------------
262 
263  DO ijk=1,ubound(plevel%edgeCells(iedge)%cells,1)
264  pedgecellsxbuff => plevel%edgeCells(iedge)%cells(ijk)%bufferExchPlag
265  pedgecellsxbuff%nBuffSize = 0
266  pedgecellsxbuff%nBuffSizeDes = 0
267  ENDDO ! ijk
268 
269 3999 CONTINUE
270  ENDDO ! iEdge
271 
272 ! - Initialize buffer size for all corner cells -------------------------------
273 
274  DO iedge=1,12
275 
276 ! -- Bypass for noninteracting regions ----------------------------------------
277 
278  IF( .NOT. plevel%edgeCells(iedge)%interact ) goto 4999
279 
280 ! -- Bypass for degenerate edge cells -----------------------------------------
281 
282  IF( plevel%edgeCells(iedge)%degenrt /= degenerat_none ) goto 4999
283 
284 ! -- Set pointer --------------------------------------------------------------
285 
286  DO ijk=1,ubound(plevel%edgeCells(iedge)%cells,1)
287  pedgecellsxbuff => plevel%edgeCells(iedge)%cells(ijk)%bufferExchPlag
288 
289 ! PRINT*, 'ASSOCIATED(cells)= ',ASSOCIATED(pLevel%edgeCells(iEdge)%cells)
290 ! PRINT*, 'ASSOCIATED(pEdgeCellsXBuff)= ',ASSOCIATED(pEdgeCellsXBuff)
291 
292  pedgecellsxbuff%nBuffSizeTot = nbuffsizeedge
293 
294 ! -- Allocate buffer data -----------------------------------------------------
295 
296  ALLOCATE( pedgecellsxbuff%aiv(naiv,nbuffsizeedge),stat=errorflag )
297  global%error = errorflag
298  IF (global%error /= err_none) THEN
299  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%aiv' )
300  END IF ! global%error
301 
302  ALLOCATE( pedgecellsxbuff%arv(narv,nbuffsizeedge),stat=errorflag )
303  global%error = errorflag
304  IF (global%error /= err_none) THEN
305  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%arv' )
306  END IF ! global%error
307 
308  ALLOCATE( pedgecellsxbuff%cv(ncv,nbuffsizeedge),stat=errorflag )
309  global%error = errorflag
310  IF (global%error /= err_none) THEN
311  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%cv' )
312  END IF ! global%error
313 
314  ALLOCATE( pedgecellsxbuff%dv(ndv,nbuffsizeedge),stat=errorflag )
315  global%error = errorflag
316  IF (global%error /= err_none) THEN
317  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%dv' )
318  END IF ! global%error
319 
320  ALLOCATE( pedgecellsxbuff%tv(ntv,nbuffsizeedge),stat=errorflag )
321  global%error = errorflag
322  IF (global%error /= err_none) THEN
323  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%tv' )
324  END IF ! global%error
325 
326  ALLOCATE( pedgecellsxbuff%aivOld(naiv,nbuffsizeedge),stat=errorflag )
327  global%error = errorflag
328  IF (global%error /= err_none) THEN
329  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%aivOld' )
330  END IF ! global%error
331 
332  ALLOCATE( pedgecellsxbuff%arvOld(narv,nbuffsizeedge),stat=errorflag )
333  global%error = errorflag
334  IF (global%error /= err_none) THEN
335  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%arvOld' )
336  END IF ! global%error
337 
338  ALLOCATE( pedgecellsxbuff%cvOld(ncv,nbuffsizeedge),stat=errorflag )
339  global%error = errorflag
340  IF (global%error /= err_none) THEN
341  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%cvOld' )
342  END IF ! global%error
343 
344  ALLOCATE( pedgecellsxbuff%rhs(ncv,nbuffsizeedge),stat=errorflag )
345  global%error = errorflag
346  IF (global%error /= err_none) THEN
347  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%rhs' )
348  END IF ! global%error
349 
350  ALLOCATE( pedgecellsxbuff%rhsSum(ncv,nbuffsizeedge),stat=errorflag )
351  global%error = errorflag
352  IF (global%error /= err_none) THEN
353  CALL errorstop( global, err_allocate,__line__,'pEdgeCellsXBuff%rhsSum' )
354  END IF ! global%error
355 
356 ! -- Initialize data --------------------------------------------------------
357 
358  pedgecellsxbuff%aiv = 0
359  pedgecellsxbuff%arv = 0.0_rfreal
360  pedgecellsxbuff%cv = 0.0_rfreal
361  pedgecellsxbuff%dv = 0.0_rfreal
362  pedgecellsxbuff%tv = 0.0_rfreal
363 
364  pedgecellsxbuff%aivOld = 0
365  pedgecellsxbuff%arvOld = 0.0_rfreal
366  pedgecellsxbuff%cvOld = 0.0_rfreal
367 
368  pedgecellsxbuff%rhs = 0.0_rfreal
369  pedgecellsxbuff%rhsSum = 0.0_rfreal
370  ENDDO ! ijk
371 
372 4999 CONTINUE
373 
374  ENDDO ! iEdge
375  ENDDO ! iLev
376 
377 ! finalize --------------------------------------------------------------------
378 
379  CALL deregisterfunction( global )
380 
381 END SUBROUTINE plag_cecellsallocatedata
382 
383 !******************************************************************************
384 !
385 ! RCS Revision history:
386 !
387 ! $Log: PLAG_CECellsAllocateData.F90,v $
388 ! Revision 1.3 2008/12/06 08:44:32 mtcampbe
389 ! Updated license.
390 !
391 ! Revision 1.2 2008/11/19 22:17:45 mtcampbe
392 ! Added Illinois Open Source License/Copyright
393 !
394 ! Revision 1.1 2004/12/01 20:57:05 fnajjar
395 ! Initial revision after changing case
396 !
397 ! Revision 1.4 2004/11/29 19:23:11 fnajjar
398 ! Added bypass statement for dengerate cells and initialized buffer sizes
399 !
400 ! Revision 1.3 2004/03/10 23:10:48 fnajjar
401 ! Allocating corner-edge cells data with nPclsBuffCECellsMax
402 !
403 ! Revision 1.2 2004/01/28 21:46:28 fnajjar
404 ! Defined nBuffSizeCorn & nBuffSizeEdge for memory allocation of buffers
405 !
406 ! Revision 1.1 2003/11/12 21:37:59 fnajjar
407 ! Initial import of Corner-Edge cells Infrastructure
408 !
409 !******************************************************************************
410 
411 
412 
413 
414 
415 
416 
plag_cecellsallocatedata
subroutine plag_cecellsallocatedata(regions, iReg)
Definition: PLAG_CECellsAllocateData.F90:47
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
modpartlag::t_plag
Definition: ModPartLag.F90:124
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
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
modpartlag::t_plag_input
Definition: ModPartLag.F90:59