Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_AllocateDataBuffers.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 ! for all active regions on current processor.
27 !
28 ! Description: none.
29 !
30 ! Input: regions = all regions
31 ! iReg = region number.
32 !
33 ! Output: region%levels%patch%buffPlag = Buffplag variables
34 !
35 ! Notes: none.
36 !
37 !******************************************************************************
38 !
39 ! $Id: PLAG_AllocateDataBuffers.F90,v 1.5 2008/12/06 08:44:32 mtcampbe Exp $
40 !
41 ! Copyright: (c) 2002 by the University of Illinois
42 !
43 !******************************************************************************
44 
45 SUBROUTINE plag_allocatedatabuffers( regions, iReg )
46 
47  USE moddatatypes
49  USE modbndpatch, ONLY : t_patch
50  USE moddatastruct, ONLY : t_region, t_level
51  USE modglobal, ONLY : t_global
52  USE modpartlag, ONLY : t_plag
53  USE moderror
54  USE modparameters
57  USE modmpi
58 
59 #ifdef STATS
61 #endif
62 
63  IMPLICIT NONE
64 
65 ! ... parameters
66  TYPE(t_region), POINTER :: regions(:)
67 
68  INTEGER :: ireg
69 
70 ! ... loop variables
71  INTEGER :: ilev, ipatch
72 
73 ! ... local variables
74  CHARACTER(CHRLEN) :: rcsidentstring
75 
76  INTEGER :: bctype, errorflag, iregdes, lbound, n1, n2, naiv, narv, &
77  nbuffi, nbuffr,nbuffsizei, nbuffsizer, nbuffsizetot, &
78  ncont, ncv, ndv, npatchsize, ntv
79 
80  TYPE(t_patch), POINTER :: ppatch
81  TYPE(t_buffer_plag), POINTER :: pbuffplag
82  TYPE(t_plag), POINTER :: pplag
83  TYPE(t_global), POINTER :: global
84 
85 !******************************************************************************
86 
87  rcsidentstring = '$RCSfile: PLAG_AllocateDataBuffers.F90,v $ $Revision: 1.5 $'
88 
89  global => regions(ireg)%global
90 
91  CALL registerfunction( global, 'PLAG_AllocateDataBuffers',&
92  'PLAG_AllocateDataBuffers.F90' )
93 
94  IF ( global%myProcid == masterproc .AND. &
95  global%verbLevel > verbose_none ) THEN
96  WRITE(stdout,'(A,3X,A)') solver_name,'Allocating Data Buffers for PLAG...'
97  END IF ! global%verbLevel
98 
99 ! Get dimensions --------------------------------------------------------------
100 
101  ncont = regions(ireg)%plagInput%nCont
102  nbuffsizetot = regions(ireg)%plagInput%nPclsBuffTot
103 
104 ! Loop over all grid levels ---------------------------------------------------
105 
106  DO ilev=1,regions(ireg)%nGridLevels
107 
108  pplag => regions(ireg)%levels(ilev)%plag
109  pplag%nRequests = 0
110 
111  naiv = pplag%nAiv
112  narv = pplag%nArv
113 
114  ncv = pplag%nCv
115  ndv = pplag%nDv
116  ntv = pplag%nTv
117 
118  nbuffi = 2*naiv
119  nbuffr = 2*narv +4*ncv +ndv +ntv
120 
121  DO ipatch=1,regions(ireg)%nPatches
122 
123  ppatch => regions(ireg)%levels(ilev)%patches(ipatch)
124  bctype = ppatch%bcType
125  lbound = ppatch%lbound
126  iregdes = ppatch%srcRegion
127 
128  n1 = abs(ppatch%l1end -ppatch%l1beg ) + 1
129  n2 = abs(ppatch%l2end -ppatch%l2beg ) + 1
130  npatchsize = n1*n2
131 
132  pbuffplag => ppatch%bufferPlag
133 
134  IF ( (bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
135  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
136  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range) ) THEN
137 
138  pbuffplag%nBuffSizeTot = nbuffsizetot
139 
140 ! - Allocate buffer data ------------------------------------------------------
141 
142  ALLOCATE( pbuffplag%aiv(naiv,nbuffsizetot),stat=errorflag )
143  global%error = errorflag
144  IF (global%error /= err_none) THEN
145  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%aiv' )
146  END IF ! global%error
147 
148  ALLOCATE( pbuffplag%arv(narv,nbuffsizetot),stat=errorflag )
149  global%error = errorflag
150  IF (global%error /= err_none) THEN
151  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%arv' )
152  END IF ! global%error
153 
154  ALLOCATE( pbuffplag%cv(ncv,nbuffsizetot),stat=errorflag )
155  global%error = errorflag
156  IF (global%error /= err_none) THEN
157  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%cv' )
158  END IF ! global%error
159 
160  ALLOCATE( pbuffplag%dv(ndv,nbuffsizetot),stat=errorflag )
161  global%error = errorflag
162  IF (global%error /= err_none) THEN
163  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%dv' )
164  END IF ! global%error
165 
166  ALLOCATE( pbuffplag%tv(ntv,nbuffsizetot),stat=errorflag )
167  global%error = errorflag
168  IF (global%error /= err_none) THEN
169  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%tv' )
170  END IF ! global%error
171 
172  ALLOCATE( pbuffplag%aivOld(naiv,nbuffsizetot),stat=errorflag )
173  global%error = errorflag
174  IF (global%error /= err_none) THEN
175  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%aivOld' )
176  END IF ! global%error
177 
178  ALLOCATE( pbuffplag%arvOld(narv,nbuffsizetot),stat=errorflag )
179  global%error = errorflag
180  IF (global%error /= err_none) THEN
181  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%arvOld' )
182  END IF ! global%error
183 
184  ALLOCATE( pbuffplag%cvOld(ncv,nbuffsizetot),stat=errorflag )
185  global%error = errorflag
186  IF (global%error /= err_none) THEN
187  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%cvOld' )
188  END IF ! global%error
189 
190  ALLOCATE( pbuffplag%rhs(ncv,nbuffsizetot),stat=errorflag )
191  global%error = errorflag
192  IF (global%error /= err_none) THEN
193  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%rhs' )
194  END IF ! global%error
195 
196  ALLOCATE( pbuffplag%rhsSum(ncv,nbuffsizetot),stat=errorflag )
197  global%error = errorflag
198  IF (global%error /= err_none) THEN
199  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%rhsSum' )
200  END IF ! global%error
201 
202 ! -- Initialize data --------------------------------------------------------
203 
204  pbuffplag%nBuffSize = 0
205  pbuffplag%nBuffSizeDes = 0
206 
207  pbuffplag%aiv = 0
208  pbuffplag%arv = 0.0_rfreal
209  pbuffplag%cv = 0.0_rfreal
210  pbuffplag%dv = 0.0_rfreal
211  pbuffplag%tv = 0.0_rfreal
212 
213  pbuffplag%aivOld = 0.0_rfreal
214  pbuffplag%arvOld = 0.0_rfreal
215  pbuffplag%cvOld = 0.0_rfreal
216 
217  pbuffplag%rhs = 0.0_rfreal
218  pbuffplag%rhsSum = 0.0_rfreal
219 
220 ! - Allocate data for off-processor communication -----------------------------
221 
222  IF (regions(iregdes)%procid /= global%myProcid) THEN ! other processor
223  nbuffsizei = nbuffi *nbuffsizetot
224  nbuffsizer = nbuffr *nbuffsizetot
225 
226  pbuffplag%nSendBuffTotI = nbuffsizei
227  pbuffplag%nSendBuffTotR = nbuffsizer
228 
229  pbuffplag%nRecvBuffTotI = nbuffsizei
230  pbuffplag%nRecvBuffTotR = nbuffsizer
231 
232  ALLOCATE( pbuffplag%sendBuffR(nbuffsizer),stat=errorflag )
233  global%error = errorflag
234  IF (global%error /= err_none) THEN
235  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%sendBuffR' )
236  END IF ! global%error
237 
238  ALLOCATE( pbuffplag%recvBuffR(nbuffsizer),stat=errorflag )
239  global%error = errorflag
240  IF (global%error /= err_none) THEN
241  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%recvBuffR' )
242  END IF ! global%error
243 
244  ALLOCATE( pbuffplag%sendBuffI(nbuffsizei),stat=errorflag )
245  global%error = errorflag
246  IF (global%error /= err_none) THEN
247  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%sendBuffI' )
248  END IF ! global%error
249 
250  ALLOCATE( pbuffplag%recvBuffI(nbuffsizei),stat=errorflag )
251  global%error = errorflag
252  IF (global%error /= err_none) THEN
253  CALL errorstop( global, err_allocate,__line__,'pBuffPlag%recvBuffI' )
254  END IF ! global%error
255 
256 ! -- Initialize data --------------------------------------------------------
257 
258  pbuffplag%sendBuffI = 0
259  pbuffplag%sendBuffR = 0.0_rfreal
260 
261  pbuffplag%recvBuffI = 0
262  pbuffplag%recvBuffR = 0.0_rfreal
263 
264 ! -- Set MPI request --------------------------------------------------------
265 
266  pplag%nRequests = pplag%nRequests + 1
267  pbuffplag%iRequest = pplag%nRequests
268 
269  ENDIF ! regions
270 
271  ELSE IF ((bctype>=bc_regionint .AND. bctype<=bc_regionint +bc_range) .OR. &
272  (bctype>=bc_regnonconf .AND. bctype<=bc_regnonconf+bc_range)) THEN
273  CALL errorstop( global,err_unknown_bc,__line__ ) ! #### TEMPORARY ####
274 
275  ELSE
276  nullify(pbuffplag%aiv)
277  nullify(pbuffplag%arv)
278  nullify(pbuffplag%cv)
279  nullify(pbuffplag%dv)
280  nullify(pbuffplag%tv)
281  nullify(pbuffplag%rhs)
282  nullify(pbuffplag%rhsSum)
283  nullify(pbuffplag%aivOld)
284  nullify(pbuffplag%arvOld)
285  nullify(pbuffplag%cvOld)
286  nullify(pbuffplag%sendBuffR)
287  nullify(pbuffplag%sendBuffI)
288  nullify(pbuffplag%recvBuffR)
289  nullify(pbuffplag%recvBuffI)
290  ENDIF ! bcType
291 
292  ENDDO ! iPatch
293 
294 ! Allocate array for send requests --------------------------------------------
295 ! Note: Need to take into account corners and edges
296 
297 #ifdef MPI
298 
299 !- request for buffer size
300 
301  ALLOCATE( pplag%requests(pplag%nRequests),stat=errorflag )
302  global%error = errorflag
303  IF (global%error /= err_none) THEN
304  CALL errorstop( global, err_allocate,__line__,'pPlag%requests' )
305  END IF ! global%error
306 
307 !- request for integer data buffer
308 
309  ALLOCATE( pplag%requestsI(pplag%nRequests),stat=errorflag )
310  global%error = errorflag
311  IF (global%error /= err_none) THEN
312  CALL errorstop( global, err_allocate,__line__,'pPlag%requestsI' )
313  END IF ! global%error
314 
315 !- request for real data buffer
316 
317  ALLOCATE( pplag%requestsR(pplag%nRequests),stat=errorflag )
318  global%error = errorflag
319  IF (global%error /= err_none) THEN
320  CALL errorstop( global, err_allocate,__line__,'pPlag%requestsR' )
321  END IF ! global%error
322 
323 #endif
324 
325  ENDDO ! iLev
326 
327 ! Allocate pertinent data for corner and edge cells ---------------------------
328 
329  CALL plag_cecellsallocatedata(regions,ireg)
330 
331 ! Allocate buffer arrays for statistics ---------------------------------------
332 
333 #ifdef STATS
334  CALL plag_rflo_createstatbuff(regions,ireg)
335 #endif
336 
337 ! finalize --------------------------------------------------------------------
338 
339  CALL deregisterfunction( global )
340 
341 END SUBROUTINE plag_allocatedatabuffers
342 
343 !******************************************************************************
344 !
345 ! RCS Revision history:
346 !
347 ! $Log: PLAG_AllocateDataBuffers.F90,v $
348 ! Revision 1.5 2008/12/06 08:44:32 mtcampbe
349 ! Updated license.
350 !
351 ! Revision 1.4 2008/11/19 22:17:45 mtcampbe
352 ! Added Illinois Open Source License/Copyright
353 !
354 ! Revision 1.3 2006/04/07 15:19:23 haselbac
355 ! Removed tabs
356 !
357 ! Revision 1.2 2005/02/16 14:43:59 fnajjar
358 ! Added call to allocate buffer arrays for statistics
359 !
360 ! Revision 1.1 2004/12/01 20:56:49 fnajjar
361 ! Initial revision after changing case
362 !
363 ! Revision 1.12 2003/11/12 21:22:02 fnajjar
364 ! Included Corner-Edge cells memory allocation
365 !
366 ! Revision 1.11 2003/05/27 19:13:48 fnajjar
367 ! Removed distPartBurning and all pertinent LOGICAL datastructure
368 !
369 ! Revision 1.10 2003/02/06 16:14:46 f-najjar
370 ! Included memory allocation for requests of integer and real data buffers
371 !
372 ! Revision 1.9 2003/01/24 19:49:55 f-najjar
373 ! Cleaned up definition of nAiv, nArv, nCv, nDv, nTv based on pPlag
374 !
375 ! Revision 1.8 2003/01/24 19:40:23 f-najjar
376 ! Bug fix to define nBuffL correctly
377 !
378 ! Revision 1.7 2003/01/23 17:21:57 f-najjar
379 ! Removed Hidden TABs
380 !
381 ! Revision 1.6 2003/01/23 00:15:05 f-najjar
382 ! Corrected buffer size for Real variables and defined nBuffI, nBuffL, nBuffR
383 !
384 ! Revision 1.5 2003/01/23 00:01:02 f-najjar
385 ! Redefined iRequest based on pBuffPlag
386 !
387 ! Revision 1.4 2003/01/22 23:55:50 f-najjar
388 ! Added MPI-related request data
389 !
390 ! Revision 1.3 2003/01/16 22:35:14 f-najjar
391 ! Activated buffers for on and off processor communication
392 !
393 ! Revision 1.2 2003/01/13 19:04:52 f-najjar
394 ! Added initialization for buffer data and renamed iRegSrc to iRegDes
395 !
396 ! Revision 1.1 2002/10/25 14:13:59 f-najjar
397 ! Initial Import of Rocpart
398 !
399 !
400 !******************************************************************************
401 
402 
403 
404 
405 
406 
407 
subroutine plag_cecellsallocatedata(regions, iReg)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine, public plag_rflo_createstatbuff(regions, iReg)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine plag_allocatedatabuffers(regions, iReg)
subroutine deregisterfunction(global)
Definition: ModError.F90:469