Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
INRT_CalcHeatTransferNonBurn.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: compute interaction source for thermal forces on Lagrangian particles
26 !
27 ! Description: none.
28 !
29 ! Input: region = current region.
30 !
31 ! Output: region%levels(iLev)%plag%inrtSources
32 !
33 ! Notes: none.
34 !
35 !******************************************************************************
36 !
37 ! $Id: INRT_CalcHeatTransferNonBurn.F90,v 1.3 2008/12/06 08:44:31 mtcampbe Exp $
38 !
39 ! Copyright: (c) 2003 by the University of Illinois
40 !
41 !******************************************************************************
42 
43 SUBROUTINE inrt_calcheattransfernonburn( 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 moderror
51 
52 #ifdef PLAG
54 #endif
55  IMPLICIT NONE
56 
57 ! ... parameters
58  TYPE(t_region), INTENT(INOUT), TARGET :: region
59 
60 ! ... loop variables
61  INTEGER :: ipcls
62 
63 ! ... local variables
64  CHARACTER(CHRLEN) :: rcsidentstring
65 
66  INTEGER :: thermalmodel, icont, ncont, npcls
67 #ifdef RFLO
68  INTEGER :: ilev
69 #endif
70  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass
71  INTEGER, POINTER, DIMENSION(:,:) :: paiv
72 
73  REAL(RFREAL) :: accell, diaml, heatcapl, mixtvolr, onethird, pi, &
74  prlam, psil, relvelmagl, reltemp, reyl, taulr
75 
76  REAL(RFREAL), DIMENSION(3) :: relvel
77  REAL(RFREAL), POINTER, DIMENSION(:) :: pspcheat
78  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pcv, pdv, ptv
79 
80  TYPE(t_plag) , POINTER :: pplag
81  TYPE(t_global), POINTER :: global
82 
83 !******************************************************************************
84 
85  rcsidentstring = &
86  '$RCSfile: INRT_CalcHeatTransferNonBurn.F90,v $ $Revision: 1.3 $'
87 
88  global => region%global
89 
90  CALL registerfunction( global,'INRT_CalcHeatTransferNonBurn',&
91  'INRT_CalcHeatTransferNonBurn.F90' )
92 
93 #ifdef PLAG
94 ! begin -----------------------------------------------------------------------
95 
96 ! Check if there are any particles
97 
98  npcls = 0
99 
100 #ifdef RFLO
101  ilev = region%currLevel
102  IF (global%plagUsed) npcls = region%levels(ilev)%plag%nPcls
103 #endif
104 #ifdef RFLU
105  IF (global%plagUsed) npcls = region%plag%nPcls
106 #endif
107 
108  IF (npcls < 1) go to 999
109 
110 ! Get dimensions --------------------------------------------------------------
111 
112  onethird = 1.0_rfreal/3.0_rfreal
113  pi = global%pi
114  prlam = global%prLam
115 
116  ncont = region%plagInput%nCont
117  thermalmodel = region%inrtInput%inrts(inrt_type_htransnb)%switches( &
118  inrt_swi_htransnb_model)
119 
120 ! Set pointers ----------------------------------------------------------------
121 
122 #ifdef RFLO
123  pplag => region%levels(ilev)%plag
124 #endif
125 #ifdef RFLU
126  pplag => region%plag
127 #endif
128 
129  paiv => pplag%aiv
130  pcv => pplag%cv
131  pdv => pplag%dv
132  ptv => pplag%tv
133 
134  pcvplagmass => pplag%cvPlagMass
135  pspcheat => region%plagInput%spht
136 
137 ! Loop over all the particles -------------------------------------------------
138 
139  DO ipcls = 1,npcls
140 
141  IF (paiv(aiv_plag_burnstat,ipcls) /= inrt_burnstat_off) cycle
142 
143  diaml = pdv(dv_plag_diam,ipcls)
144 
145  heatcapl = sum( pcv(pcvplagmass(:),ipcls) * pspcheat(:) )
146 
147 ! - Compute thermal timescale for nonburning particles ------------------------
148 
149  taulr = 2.0_rfreal*pi*ptv(tv_plag_tcolmixt,ipcls) * diaml/heatcapl
150 
151  reltemp = pdv(dv_plag_tempmixt,ipcls)-pdv(dv_plag_temp,ipcls)
152 
153  SELECT CASE (thermalmodel)
154 
155  CASE (inrt_htransnb_model_stokes)
156 
157  psil = 1.0_rfreal
158 
159  CASE (inrt_htransnb_model_rm)
160 
161  relvel(1) = pdv(dv_plag_uvelmixt,ipcls)-pdv(dv_plag_uvel,ipcls)
162  relvel(2) = pdv(dv_plag_vvelmixt,ipcls)-pdv(dv_plag_vvel,ipcls)
163  relvel(3) = pdv(dv_plag_wvelmixt,ipcls)-pdv(dv_plag_wvel,ipcls)
164 
165  relvelmagl = sqrt( relvel(1)*relvel(1)+ &
166  relvel(2)*relvel(2)+ &
167  relvel(3)*relvel(3) )
168 
169  reyl = diaml * relvelmagl * pdv(dv_plag_densmixt,ipcls) / &
170  ptv(tv_plag_muelmixt,ipcls)
171 
172  psil = 1.0_rfreal + 0.3_rfreal* (reyl**0.5_rfreal) *(prlam**onethird)
173 
174  CASE default
175  CALL errorstop( global,err_reached_default,__line__ )
176 
177  END SELECT ! thermalModel
178 
179  accell = psil*reltemp*taulr
180 
181 ! - fill the effect of the particles (L) on the gas (G).
182 ! - the source terms will be added to the particle Rhs.
183 
184  pplag%inrtSources(inrt_htransnb_l_ener_g,ipcls) = - heatcapl*accell
185 
186  END DO ! iPcls
187 
188 ! finalize --------------------------------------------------------------------
189 
190 999 CONTINUE
191 #endif
192  CALL deregisterfunction( global )
193 
194 END SUBROUTINE inrt_calcheattransfernonburn
195 
196 !******************************************************************************
197 !
198 ! RCS Revision history:
199 !
200 ! $Log: INRT_CalcHeatTransferNonBurn.F90,v $
201 ! Revision 1.3 2008/12/06 08:44:31 mtcampbe
202 ! Updated license.
203 !
204 ! Revision 1.2 2008/11/19 22:17:44 mtcampbe
205 ! Added Illinois Open Source License/Copyright
206 !
207 ! Revision 1.1 2004/12/01 21:56:15 fnajjar
208 ! Initial revision after changing case
209 !
210 ! Revision 1.7 2004/03/05 22:09:03 jferry
211 ! created global variables for peul, plag, and inrt use
212 !
213 ! Revision 1.6 2004/03/02 21:47:29 jferry
214 ! Added After Update interactions
215 !
216 ! Revision 1.5 2004/01/31 03:59:22 haselbac
217 ! Initial integration for Rocflu and Rocpart
218 !
219 ! Revision 1.4 2003/04/03 21:10:18 jferry
220 ! implemented additional safety checks for rocinteract
221 !
222 ! Revision 1.3 2003/04/02 22:32:03 jferry
223 ! codified Activeness and Permission structures for rocinteract
224 !
225 ! Revision 1.2 2003/03/11 16:09:39 jferry
226 ! Added comments
227 !
228 ! Revision 1.1 2003/03/04 22:12:35 jferry
229 ! Initial import of Rocinteract
230 !
231 !******************************************************************************
232 
233 
234 
235 
236 
237 
238 
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
double sqrt(double d)
Definition: double.h:73
static const double pi
Definition: smooth_medial.C:43
subroutine inrt_calcheattransfernonburn(region)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469