Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_RFLU_AllocMemSolTile.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 Lagrangian particle tile solution.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! pRegion Region pointer
31 !
32 ! Output: None.
33 !
34 ! Notes: None.
35 !
36 !******************************************************************************
37 !
38 ! $Id: PLAG_RFLU_AllocMemSolTile.F90,v 1.6 2008/12/06 08:44:35 mtcampbe Exp $
39 !
40 ! Copyright: (c) 2004 by the University of Illinois
41 !
42 !******************************************************************************
43 
44 SUBROUTINE plag_rflu_allocmemsoltile(pRegion)
45 
46  USE moddatatypes
47  USE moderror
48  USE modparameters
49  USE modglobal, ONLY: t_global
50  USE modbndpatch, ONLY: t_patch
51  USE modgrid, ONLY: t_grid
52  USE moddatastruct, ONLY: t_region
53  USE modpartlag, ONLY: t_tile_plag
54  USE modmpi
55 
57 
58  IMPLICIT NONE
59 
60 ! ******************************************************************************
61 ! Definitions and declarations
62 ! ******************************************************************************
63 
64 ! ==============================================================================
65 ! Arguments
66 ! ==============================================================================
67 
68  TYPE(t_region), POINTER :: pregion
69 
70 ! ==============================================================================
71 ! Locals
72 ! ==============================================================================
73 
74  CHARACTER(CHRLEN) :: rcsidentstring
75  INTEGER :: errorflag,icont,ipatch,itile,ivar,ncont,ncv,ndv,ntiles
76  TYPE(t_grid), POINTER :: pgrid
77  TYPE(t_global), POINTER :: global
78  TYPE(t_patch), POINTER :: ppatch
79  TYPE(t_tile_plag), POINTER :: ptileplag
80 
81 ! ******************************************************************************
82 ! Start
83 ! ******************************************************************************
84 
85  rcsidentstring = '$RCSfile: PLAG_RFLU_AllocMemSolTile.F90,v $ $Revision: 1.6 $'
86 
87  global => pregion%global
88 
89  CALL registerfunction(global,'PLAG_RFLU_AllocMemSolTile',&
90  'PLAG_RFLU_AllocMemSolTile.F90')
91 
92 ! ******************************************************************************
93 ! Set pointers and variables
94 ! ******************************************************************************
95 
96  pgrid => pregion%grid
97 
98  ncont = pregion%plagInput%nCont
99 
100 ! ******************************************************************************
101 ! Allocate memory
102 ! ******************************************************************************
103 
104  DO ipatch = 1,pgrid%nPatches
105  ppatch => pregion%patches(ipatch)
106 
107  IF ( (ppatch%bcType >= bc_injection .AND. ppatch%bcType <= bc_injection + bc_range) .OR. &
108  (ppatch%bcType >= bc_inflow .AND. ppatch%bcType <= bc_inflow + bc_range) ) THEN
109  ptileplag => ppatch%tilePlag
110 
111  ppatch%tilePlag%nCv = cv_tile_last + ncont
112  ppatch%tilePlag%nDv = dv_tile_last
113 
114  ncv = ptileplag%nCv
115  ndv = ptileplag%nDv
116 
117  ntiles = ppatch%nBFaces
118 
119  ALLOCATE(ptileplag%cv(ncv,ntiles),stat=errorflag)
120  global%error = errorflag
121  IF (global%error /= err_none) THEN
122  CALL errorstop(global, err_allocate,__line__,'pTilePlag%cv')
123  END IF ! global%error
124 
125  ALLOCATE(ptileplag%dv(ndv,ntiles),stat=errorflag)
126  global%error = errorflag
127  IF (global%error /= err_none) THEN
128  CALL errorstop(global, err_allocate,__line__,'pTilePlag%dv')
129  END IF ! global%error
130 
131  ALLOCATE(ptileplag%cvTileMass(ncont),stat=errorflag)
132  global%error = errorflag
133  IF (global%error /= err_none) THEN
134  CALL errorstop(global, err_allocate,__line__,'pTilePlag%cvTileMass')
135  END IF ! global%error
136 
137  DO icont = 1,ncont
138  ptileplag%cvTileMass(icont) = cv_tile_last + icont
139  END DO ! iCont
140  END IF ! pPatch%bcType
141  END DO ! iPatch
142 
143 ! ******************************************************************************
144 ! Initialize memory
145 ! ******************************************************************************
146 
147  DO ipatch = 1,pgrid%nPatches
148  ppatch => pregion%patches(ipatch)
149 
150  IF ( (ppatch%bcType >= bc_injection .AND. ppatch%bcType <= bc_injection + bc_range) .OR. &
151  (ppatch%bcType >= bc_inflow .AND. ppatch%bcType <= bc_inflow + bc_range) ) THEN
152  ptileplag => ppatch%tilePlag
153 
154  ncv = ptileplag%nCv
155  ndv = ptileplag%nDv
156 
157  ntiles = ppatch%nBFaces
158 
159  DO itile = 1,ntiles
160  DO ivar = 1,ncv
161  ptileplag%cv(ivar,itile) = 0.0_rfreal
162  END DO ! iVar
163 
164  DO ivar = 1,ndv
165  ptileplag%dv(ivar,itile) = 0.0_rfreal
166  END DO ! iVar
167  END DO ! iTile
168  END IF ! pPatch%bcType
169  END DO ! iPatch
170 
171 ! ******************************************************************************
172 ! End
173 ! ******************************************************************************
174 
175  CALL deregisterfunction(global)
176 
177 END SUBROUTINE plag_rflu_allocmemsoltile
178 
179 !******************************************************************************
180 !
181 ! RCS Revision history:
182 !
183 ! $Log: PLAG_RFLU_AllocMemSolTile.F90,v $
184 ! Revision 1.6 2008/12/06 08:44:35 mtcampbe
185 ! Updated license.
186 !
187 ! Revision 1.5 2008/11/19 22:17:47 mtcampbe
188 ! Added Illinois Open Source License/Copyright
189 !
190 ! Revision 1.4 2006/09/18 20:32:49 fnajjar
191 ! Activated tile datastructure for inflow bc
192 !
193 ! Revision 1.3 2006/04/07 15:19:24 haselbac
194 ! Removed tabs
195 !
196 ! Revision 1.2 2004/03/08 23:02:28 fnajjar
197 ! Added initialization section within DO-loop construct
198 !
199 ! Revision 1.1 2004/02/26 21:00:38 haselbac
200 ! Initial revision
201 !
202 !******************************************************************************
203 
204 
205 
206 
207 
208 
209 
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine plag_rflu_allocmemsoltile(pRegion)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469