Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
INRT_SetParticleTemp.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: set temperature of burning particles to the boiling point of Al
26 !
27 ! Description: none.
28 !
29 ! Input: region = current region.
30 !
31 ! Output: region%levels(iLev)%plag%cv
32 !
33 ! Notes:
34 !
35 ! It is the energy that is set of course, not the temperature itself.
36 !
37 ! If the boiling point of Al (or whatever constituent is burning) not between
38 ! 500 K and 5000 K, an error is returned.
39 !
40 !******************************************************************************
41 !
42 ! $Id: INRT_SetParticleTemp.F90,v 1.3 2008/12/06 08:44:32 mtcampbe Exp $
43 !
44 ! Copyright: (c) 2004 by the University of Illinois
45 !
46 !******************************************************************************
47 
48 SUBROUTINE inrt_setparticletemp( region )
49 
50  USE moddatatypes
51  USE moddatastruct, ONLY : t_region
52  USE modglobal, ONLY : t_global
53  USE modpartlag, ONLY : t_plag
54  USE modinteract, ONLY : t_inrt_interact
55  USE moderror
57 
58 #ifdef PLAG
60 #endif
61  IMPLICIT NONE
62 
63 ! ... parameters
64  TYPE(t_region), INTENT(INOUT), TARGET :: region
65 
66 ! ... loop variables
67  INTEGER :: ipcls
68 
69 ! ... local variables
70  CHARACTER(CHRLEN) :: rcsidentstring
71 
72  INTEGER :: npcls, ncont, icvmassbeg, icvmassend, icontal, imatal
73 #ifdef RFLO
74  INTEGER :: ilev
75 #endif
76  INTEGER, POINTER, DIMENSION(:,:) :: paiv
77 
78  REAL(RFREAL) :: temptarg, masssum, kinener, heatcap, enertarg
79 
80  REAL(RFREAL), POINTER, DIMENSION(:) :: pspcheat
81  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pcv
82 
83  TYPE(t_inrt_interact), POINTER :: pinrtburn
84  TYPE(t_plag), POINTER :: pplag
85  TYPE(t_global), POINTER :: global
86 
87 !******************************************************************************
88 
89  rcsidentstring = '$RCSfile: INRT_SetParticleTemp.F90,v $ $Revision: 1.3 $'
90 
91  global => region%global
92 
93  CALL registerfunction( global,'INRT_SetParticleTemp',&
94  'INRT_SetParticleTemp.F90' )
95 
96 #ifdef PLAG
97 ! begin -----------------------------------------------------------------------
98 
99 #ifdef RFLO
100  ilev = region%currLevel
101  pplag => region%levels(ilev)%plag
102 #endif
103 #ifdef RFLU
104  pplag => region%plag
105 #endif
106 
107 ! Check if there are any particles --------------------------------------------
108 
109  npcls = 0
110  IF (global%plagUsed) npcls = pplag%nPcls
111 
112  IF (npcls < 1) go to 9
113 
114 ! Set pointers and values -----------------------------------------------------
115 
116  paiv => pplag%aiv
117  pcv => pplag%cv
118 
119  pinrtburn => region%inrtInput%inrts(inrt_type_burning)
120 
121  pspcheat => region%plagInput%spht
122  ncont = region%plagInput%nCont
123 
124 ! Of 1:nCv conserved variables, iCvMassBeg is the first constituent mass index,
125 ! and iCvmassEnd is the last one.
126 
127  icvmassbeg = pplag%cvPlagMass(1)
128  icvmassend = pplag%cvPlagMass(ncont)
129 
130 ! Of 1:nCont types of particle constituents, iContAl is the index of Al
131 
132  icontal = pinrtburn%edges(inrt_burning_l_mass_x)%iNode(1) &
133  - region%inrtInput%indPlag0
134 
135  IF (icontal < 1 .OR. icontal > ncont) THEN
136  CALL errorstop( global,err_inrt_indexrange,__line__ )
137  END IF ! iContAl
138 
139 ! Of 1:nMaterials types of materials, iMatAl is the index of Al
140 
141  imatal = region%plagInput%materialIndex(icontal)
142 
143  IF (imatal < 1 .OR. imatal > global%nMaterials) THEN
144  CALL errorstop( global,err_inrt_indexrange,__line__ )
145  END IF ! iMatAl
146 
147  temptarg = global%materials(imatal)%Tboil
148 
149  IF (temptarg < 500._rfreal .OR. temptarg > 10000._rfreal) THEN
150  CALL errorstop( global,err_inrt_badval,__line__ )
151  END IF ! tempTarg
152 
153 ! Loop over all the particles -------------------------------------------------
154 
155  DO ipcls = 1,npcls
156 
157  SELECT CASE (paiv(aiv_plag_burnstat,ipcls))
158 
159  CASE (inrt_burnstat_off)
160 
161  cycle
162 
163  CASE (inrt_burnstat_on)
164 
165  masssum = sum( pcv(icvmassbeg:icvmassend,ipcls) )
166 
167  kinener = dot_product( pcv(cv_plag_xmom:cv_plag_zmom,ipcls), &
168  pcv(cv_plag_xmom:cv_plag_zmom,ipcls) ) * &
169  0.5_rfreal / masssum
170 
171  heatcap = dot_product( pcv(icvmassbeg:icvmassend,ipcls),pspcheat(:) )
172 
173  enertarg = kinener + heatcap*temptarg
174 
175 ! --- Should have switch here for what to do with energy difference in the
176 ! --- case of active particles.
177 
178 ! --- Current implementation: ignore energy difference
179 ! --- This is justified for strongly burning particles, but may be
180 ! --- a bad assumption when particles are weakly burning.
181 
182  pcv(cv_plag_ener,ipcls) = enertarg
183 
184  CASE default
185 
186  CALL errorstop( global,err_reached_default,__line__ )
187 
188  END SELECT ! pAiv(AIV_PLAG_BURNSTAT,iPcls)
189 
190  END DO ! iPcls
191 
192 ! finalize --------------------------------------------------------------------
193 
194 9 CONTINUE
195 #endif
196  CALL deregisterfunction( global )
197 
198 END SUBROUTINE inrt_setparticletemp
199 
200 !******************************************************************************
201 !
202 ! RCS Revision history:
203 !
204 ! $Log: INRT_SetParticleTemp.F90,v $
205 ! Revision 1.3 2008/12/06 08:44:32 mtcampbe
206 ! Updated license.
207 !
208 ! Revision 1.2 2008/11/19 22:17:44 mtcampbe
209 ! Added Illinois Open Source License/Copyright
210 !
211 ! Revision 1.1 2004/12/01 21:56:43 fnajjar
212 ! Initial revision after changing case
213 !
214 ! Revision 1.2 2004/03/05 22:09:03 jferry
215 ! created global variables for peul, plag, and inrt use
216 !
217 ! Revision 1.1 2004/03/02 21:47:29 jferry
218 ! Added After Update interactions
219 !
220 !******************************************************************************
221 
222 
223 
224 
225 
226 
227 
Tfloat sum() const
Return the sum of all the pixel values in an image.
Definition: CImg.h:13022
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
long double dot_product(pnt vec1, pnt vec2)
subroutine inrt_setparticletemp(region)
subroutine deregisterfunction(global)
Definition: ModError.F90:469