Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_RFLU_AllocMemSol.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 solution.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! pRegion Region pointer
31 ! pPlag Pointer to particle data structure
32 !
33 ! Output: None.
34 !
35 ! Notes: None.
36 !
37 !******************************************************************************
38 !
39 ! $Id: PLAG_RFLU_AllocMemSol.F90,v 1.7 2008/12/06 08:44:35 mtcampbe Exp $
40 !
41 ! Copyright: (c) 2004 by the University of Illinois
42 !
43 !******************************************************************************
44 
45 SUBROUTINE plag_rflu_allocmemsol(pRegion,pPlag)
46 
47  USE moddatatypes
48  USE moderror
49  USE modparameters
50  USE modglobal, ONLY: t_global
51  USE modgrid, ONLY: t_grid
52  USE moddatastruct, ONLY: t_region
53  USE modpartlag, ONLY: t_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  TYPE(t_plag), POINTER :: pplag
70 
71 ! ==============================================================================
72 ! Locals
73 ! ==============================================================================
74 
75  CHARACTER(CHRLEN) :: rcsidentstring
76  INTEGER :: errorflag,icont,ipcl,ivar,naiv,narv,ncont,ncv,ndv,npclsmax,ntv
77  TYPE(t_grid), POINTER :: pgrid
78  TYPE(t_global), POINTER :: global
79 
80 ! ******************************************************************************
81 ! Start
82 ! ******************************************************************************
83 
84  rcsidentstring = '$RCSfile: PLAG_RFLU_AllocMemSol.F90,v $ $Revision: 1.7 $'
85 
86  global => pregion%global
87 
88  CALL registerfunction(global,'PLAG_RFLU_AllocMemSol',&
89  'PLAG_RFLU_AllocMemSol.F90')
90 
91 ! ******************************************************************************
92 ! Set pointers and variables
93 ! ******************************************************************************
94 
95  pgrid => pregion%grid
96 
97  npclsmax = pregion%plag%nPclsMax
98  ncont = pregion%plagInput%nCont
99 
100  naiv = pplag%nAiv
101  narv = pplag%nArv
102 
103  ncv = pplag%nCv
104  ndv = pplag%nDv
105  ntv = pplag%nTv
106 
107 ! ******************************************************************************
108 ! Allocate memory
109 ! ******************************************************************************
110 
111 ! ==============================================================================
112 ! State vector
113 ! ==============================================================================
114 
115  ALLOCATE(pplag%cv(ncv,npclsmax),stat=errorflag)
116  global%error = errorflag
117  IF (global%error /= err_none) THEN
118  CALL errorstop(global,err_allocate,__line__,'pPlag%cv')
119  END IF ! global%error
120 
121 ! ==============================================================================
122 ! Dependent variables
123 ! ==============================================================================
124 
125  ALLOCATE(pplag%dv(ndv,npclsmax),stat=errorflag)
126  global%error = errorflag
127  IF (global%error /= err_none) THEN
128  CALL errorstop(global,err_allocate,__line__,'pPlag%dv')
129  END IF ! global%error
130 
131 ! ==============================================================================
132 ! Transport variables
133 ! ==============================================================================
134 
135  ALLOCATE(pplag%tv(ntv,npclsmax),stat=errorflag)
136  global%error = errorflag
137  IF (global%error /= err_none) THEN
138  CALL errorstop(global,err_allocate,__line__,'pPlag%tv')
139  END IF ! global%error
140 
141 ! ==============================================================================
142 ! Additional variables
143 ! ==============================================================================
144 
145  ALLOCATE(pplag%aiv(naiv,npclsmax),stat=errorflag)
146  global%error = errorflag
147  IF (global%error /= err_none) THEN
148  CALL errorstop(global,err_allocate,__line__,'pPlag%aiv')
149  END IF ! global%error
150 
151  ALLOCATE(pplag%arv(narv,npclsmax),stat=errorflag)
152  global%error = errorflag
153  IF (global%error /= err_none) THEN
154  CALL errorstop(global,err_allocate,__line__,'pPlag%arv')
155  END IF ! global%error
156 
157 ! ==============================================================================
158 ! Lagrangian particles mass and volume indices
159 ! ==============================================================================
160 
161  ALLOCATE(pplag%cvPlagMass(ncont),stat=errorflag)
162  global%error = errorflag
163  IF (global%error /= err_none) THEN
164  CALL errorstop(global, err_allocate,__line__ ,'pPlag%cvPlagMass')
165  END IF ! global%error
166 
167  ALLOCATE(pplag%dvPlagVolu(ncont),stat=errorflag)
168  global%error = errorflag
169  IF (global%error /= err_none) THEN
170  CALL errorstop(global, err_allocate,__line__ ,'pPlag%dvPlagVolu')
171  END IF ! global%error
172 
173  DO icont = 1,ncont
174  pplag%cvPlagMass(icont) = cv_plag_last + icont
175  pplag%dvPlagVolu(icont) = dv_plag_last + icont
176  END DO ! iCont
177 
178 ! ******************************************************************************
179 ! Initialize memory
180 ! ******************************************************************************
181 
182  DO ipcl = 1,npclsmax
183  DO ivar = 1,ncv
184  pplag%cv(ivar,ipcl) = 0.0_rfreal
185  END DO ! iVar
186 
187  DO ivar = 1,ndv
188  pplag%dv(ivar,ipcl) = 0.0_rfreal
189  END DO ! iVar
190 
191  DO ivar = 1,ntv
192  pplag%tv(ivar,ipcl) = 0.0_rfreal
193  END DO ! iVar
194 
195  DO ivar = 1,naiv
196  pplag%aiv(ivar,ipcl) = 0
197  END DO ! iVar
198 
199  DO ivar = 1,narv
200  pplag%arv(ivar,ipcl) = 0
201  END DO ! iVar
202  END DO ! iPcl
203 
204 ! ******************************************************************************
205 ! End
206 ! ******************************************************************************
207 
208  CALL deregisterfunction(global)
209 
210 END SUBROUTINE plag_rflu_allocmemsol
211 
212 !******************************************************************************
213 !
214 ! RCS Revision history:
215 !
216 ! $Log: PLAG_RFLU_AllocMemSol.F90,v $
217 ! Revision 1.7 2008/12/06 08:44:35 mtcampbe
218 ! Updated license.
219 !
220 ! Revision 1.6 2008/11/19 22:17:47 mtcampbe
221 ! Added Illinois Open Source License/Copyright
222 !
223 ! Revision 1.5 2007/03/06 23:15:32 fnajjar
224 ! Renamed nPclsTot to nPclsMax
225 !
226 ! Revision 1.4 2006/04/07 15:19:24 haselbac
227 ! Removed tabs
228 !
229 ! Revision 1.3 2004/07/28 18:58:13 fnajjar
230 ! Included new definition for nPclsTot from dynamic memory reallocation
231 !
232 ! Revision 1.2 2004/03/08 23:02:28 fnajjar
233 ! Added initialization section within DO-loop construct
234 !
235 ! Revision 1.1 2004/02/26 21:00:36 haselbac
236 ! Initial revision
237 !
238 !******************************************************************************
239 
240 
241 
242 
243 
244 
245 
subroutine plag_rflu_allocmemsol(pRegion, pPlag)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469