Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
INRT_BurnStatusUpdate.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: update Burning Status of Lagrangian particles
26 !
27 ! Description: none.
28 !
29 ! Input: region = current region.
30 !
31 ! Output: region%levels(iLev)%plag%aiv
32 !
33 ! Notes: none.
34 !
35 !******************************************************************************
36 !
37 ! $Id: INRT_BurnStatusUpdate.F90,v 1.3 2008/12/06 08:44:31 mtcampbe Exp $
38 !
39 ! Copyright: (c) 2004 by the University of Illinois
40 !
41 !******************************************************************************
42 
43 SUBROUTINE inrt_burnstatusupdate( region )
44 
45  USE moddatatypes
46  USE moddatastruct, ONLY : t_region
47  USE modglobal, ONLY : t_global
48  USE modpartlag, ONLY : t_plag
49  USE modinteract, ONLY : t_inrt_interact
50  USE moderror
52 
53 #ifdef PLAG
55 #endif
56  IMPLICIT NONE
57 
58 ! ... parameters
59  TYPE(t_region), INTENT(INOUT), TARGET :: region
60 
61 ! ... loop variables
62  INTEGER :: ipcls
63 
64 ! ... local variables
65  REAL(RFREAL), PARAMETER :: diamalcutoff = 5.e-7_rfreal ! 0.5-micron
66 
67  CHARACTER(CHRLEN) :: rcsidentstring
68 
69  INTEGER :: npcls, ncont, icontal, icvalmass
70 #ifdef RFLO
71  INTEGER :: ilev
72 #endif
73  INTEGER, POINTER, DIMENSION(:,:) :: paiv
74 
75  LOGICAL :: vapornotused
76 
77  REAL(RFREAL) :: densal, massalcutoff, massal
78 
79  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pcv
80 
81  TYPE(t_inrt_interact), POINTER :: pinrtburn
82  TYPE(t_plag), POINTER :: pplag
83  TYPE(t_global), POINTER :: global
84 
85 !******************************************************************************
86 
87  rcsidentstring = '$RCSfile: INRT_BurnStatusUpdate.F90,v $ $Revision: 1.3 $'
88 
89  global => region%global
90 
91  CALL registerfunction( global,'INRT_BurnStatusUpdate',&
92  'INRT_BurnStatusUpdate.F90' )
93 
94 #ifdef PLAG
95 ! begin -----------------------------------------------------------------------
96 
97 #ifdef RFLO
98  ilev = region%currLevel
99  pplag => region%levels(ilev)%plag
100 #endif
101 #ifdef RFLU
102  pplag => region%plag
103 #endif
104 
105 ! Check if there are any particles --------------------------------------------
106 
107  npcls = 0
108  IF (global%plagUsed) npcls = pplag%nPcls
109 
110  IF (npcls < 1) go to 9
111 
112 ! Set pointers and values -----------------------------------------------------
113 
114  paiv => pplag%aiv
115  pcv => pplag%cv
116 
117  pinrtburn => region%inrtInput%inrts(inrt_type_burning)
118 
119  ncont = region%plagInput%nCont
120 
121 ! Of 1:nCont types of particle constituents, iContAl is the index of Al
122 
123  icontal = pinrtburn%edges(inrt_burning_l_mass_x)%iNode(1) &
124  - region%inrtInput%indPlag0
125 
126  IF (icontal < 1 .OR. icontal > ncont) THEN
127  CALL errorstop( global,err_inrt_indexrange,__line__ )
128  END IF ! iContAl
129 
130 ! Of 1:nCv conserved variables, iCvAlMass is the index of Al mass
131 
132  icvalmass = pplag%cvPlagMass(icontal)
133 
134  densal = region%plagInput%dens(icontal)
135 
136 ! set cutoff for amount of Aluminum mass considered negligible, based on the
137 ! diameter that a particle would have if it consisted only of that Al mass.
138 
139  massalcutoff = (global%pi / 6._rfreal) * diamalcutoff**3 * densal
140 
141 ! vaporNotUsed is used to flag errors, so it is set .true. whenever
142 ! the vapor energy method is something other than "used".
143 
144  vapornotused = pinrtburn%switches(inrt_swi_burning_vapor_meth) /= &
145  inrt_burning_vapor_meth_used
146 
147 ! Loop over all the particles -------------------------------------------------
148 
149  DO ipcls = 1,npcls
150 
151  SELECT CASE (paiv(aiv_plag_burnstat,ipcls))
152 
153  CASE (inrt_burnstat_off)
154 
155 ! --- Re-light model
156 
157 ! --- Nothing yet implemented: particles not burning remain not burning
158 
159  CASE (inrt_burnstat_on)
160 
161 ! --- If vapor energy is present, the particle is always considered burning
162 
163  IF (pcv(cv_plag_enervapor,ipcls) > 0._rfreal) THEN
164 
165 ! ----- Flag error if vapor is not used, and yet, somehow, present
166 
167  IF (vapornotused) THEN
168  CALL errorstop( global,err_inrt_enervapor,__line__ )
169  END IF ! vaporNotUsed
170 
171  ELSE
172 
173 ! ----- Quench model
174 
175 ! ----- Currently this is hardwired to the condition that the Aluminum mass
176 ! ----- is less than some small, positive amount.
177 
178  massal = pcv(icvalmass,ipcls)
179 
180  IF (massal < massalcutoff) THEN
181 
182  paiv(aiv_plag_burnstat,ipcls) = inrt_burnstat_off
183 
184  END IF ! massAl
185 
186  END IF ! pCv(CV_PLAG_ENERVAPOR,iPcls)
187 
188  CASE default
189 
190  CALL errorstop( global,err_reached_default,__line__ )
191 
192  END SELECT ! pAiv(AIV_PLAG_BURNSTAT,iPcls)
193 
194  END DO ! iPcls
195 
196 ! finalize --------------------------------------------------------------------
197 
198 9 CONTINUE
199 #endif
200  CALL deregisterfunction( global )
201 
202 END SUBROUTINE inrt_burnstatusupdate
203 
204 !******************************************************************************
205 !
206 ! RCS Revision history:
207 !
208 ! $Log: INRT_BurnStatusUpdate.F90,v $
209 ! Revision 1.3 2008/12/06 08:44:31 mtcampbe
210 ! Updated license.
211 !
212 ! Revision 1.2 2008/11/19 22:17:44 mtcampbe
213 ! Added Illinois Open Source License/Copyright
214 !
215 ! Revision 1.1 2004/12/01 21:56:12 fnajjar
216 ! Initial revision after changing case
217 !
218 ! Revision 1.2 2004/03/05 22:09:03 jferry
219 ! created global variables for peul, plag, and inrt use
220 !
221 ! Revision 1.1 2004/03/02 21:47:29 jferry
222 ! Added After Update interactions
223 !
224 !******************************************************************************
225 
226 
227 
228 
229 
230 
231 
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
subroutine inrt_burnstatusupdate(region)