Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
SPEC_RFLU_ReadBcInjectSection.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: Read in user input related to injection boundary condition for
26 ! species.
27 !
28 ! Description: None.
29 !
30 ! Input:
31 ! pRegion Region pointer
32 !
33 ! Output: None.
34 !
35 ! Notes:
36 ! 1. Define additional keyword, SPEC_, which can be used to set a default
37 ! for all species. Individual species can be overridden by specifying
38 ! the appropriate keyword SPECn.
39 !
40 !******************************************************************************
41 !
42 ! $Id: SPEC_RFLU_ReadBcInjectSection.F90,v 1.5 2008/12/06 08:44:40 mtcampbe Exp $
43 !
44 ! Copyright: (c) 2003 by the University of Illinois
45 !
46 !******************************************************************************
47 
48 SUBROUTINE spec_rflu_readbcinjectsection(pRegion)
49 
50  USE moddatatypes
51  USE modbndpatch, ONLY: t_patch
52  USE moddatastruct, ONLY: t_region
53  USE modglobal, ONLY: t_global
54  USE modgrid, ONLY: t_grid
55  USE moderror
56  USE modparameters
57 
59 
60  IMPLICIT NONE
61 
62 ! *****************************************************************************
63 ! Definitions and declarations
64 ! *****************************************************************************
65 
66 ! =============================================================================
67 ! Arguments
68 ! =============================================================================
69 
70  TYPE(t_region), POINTER :: pregion
71 
72 ! =============================================================================
73 ! Locals
74 ! =============================================================================
75 
76  CHARACTER(CHRLEN) :: bcname,rcsidentstring
77  CHARACTER(10), DIMENSION(:), ALLOCATABLE :: keys
78  CHARACTER(256) :: filename
79  LOGICAL, DIMENSION(:), ALLOCATABLE :: defined
80  INTEGER :: checksum,distrib,errorflag,ifc,ikey,ipatch,ipatchbeg,ipatchend, &
81  ireg,ival,nbfacestot,nkeys
82  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: vals
83  TYPE(t_grid) :: grid
84  TYPE(t_patch), POINTER :: ppatch
85  TYPE(t_global), POINTER :: global
86 
87 ! *****************************************************************************
88 ! Start
89 ! *****************************************************************************
90 
91  rcsidentstring = '$RCSfile: SPEC_RFLU_ReadBcInjectSection.F90,v $ $Revision: 1.5 $'
92 
93  global => pregion%global
94 
95  CALL registerfunction(global,'SPEC_RFLU_ReadBcInjectSection',&
96  'SPEC_RFLU_ReadBcInjectSection.F90')
97 
98 ! *****************************************************************************
99 ! Allocate memory
100 ! *****************************************************************************
101 
102  nkeys = pregion%specInput%nSpecies + 1 ! Add one because of default key
103 
104  ALLOCATE(keys(nkeys),stat=errorflag)
105  global%error = errorflag
106  IF ( global%error /= err_none ) THEN
107  CALL errorstop(global,err_allocate,__line__,'keys')
108  END IF ! global%error
109 
110  ALLOCATE(vals(nkeys),stat=errorflag)
111  global%error = errorflag
112  IF ( global%error /= err_none ) THEN
113  CALL errorstop(global,err_allocate,__line__,'vals')
114  END IF ! global%error
115 
116  ALLOCATE(defined(nkeys),stat=errorflag)
117  global%error = errorflag
118  IF ( global%error /= err_none ) THEN
119  CALL errorstop(global,err_allocate,__line__,'defined')
120  END IF ! global%error
121 
122 ! *****************************************************************************
123 ! Generate keys. NOTE first key is default key.
124 ! *****************************************************************************
125 
126  keys(1) = 'SPEC_'
127 
128  CALL makenumberedkeys(keys,2,'SPEC',1,nkeys,1)
129 
130 ! *****************************************************************************
131 ! Read section
132 ! *****************************************************************************
133 
134  CALL readpatchsection(global,if_input,nkeys,keys,vals,ipatchbeg,ipatchend, &
135  distrib,filename,bcname,defined)
136 
137 ! *****************************************************************************
138 ! Check if specified number of patches exceeds available ones
139 ! *****************************************************************************
140 
141  IF ( ipatchend > global%nPatches ) THEN
142  CALL errorstop(global,err_patch_range,__line__)
143  END IF ! iPatchEnd
144 
145 ! *****************************************************************************
146 ! Set options and check if all necessary values defined
147 ! *****************************************************************************
148 
149  DO ipatch = 1,pregion%grid%nPatches
150  ppatch => pregion%patches(ipatch)
151 
152 ! =============================================================================
153 ! Check whether this global patch exists in this region
154 ! =============================================================================
155 
156  IF ( ppatch%iPatchGlobal >= ipatchbeg .AND. &
157  ppatch%iPatchGlobal <= ipatchend ) THEN
158 
159 ! -----------------------------------------------------------------------------
160 ! Set options. NOTE at this stage, have already read information for
161 ! mixture, so for GENx runs, pPatch%bcCoupled has been set and checked.
162 ! Hence can use it directly to determine whether need distribution.
163 ! -----------------------------------------------------------------------------
164 
165  ppatch%spec%nData = pregion%specInput%nSpecies
166  ppatch%spec%nSwitches = 0
167 
168  IF ( ppatch%bcCoupled == bc_burning ) THEN
169  ppatch%spec%distrib = bcdat_distrib ! MUST have distribution
170  ELSE
171  ppatch%spec%distrib = distrib
172  END IF ! pPatch%bcCoupled
173 
174 ! -----------------------------------------------------------------------------
175 ! Check whether all values defined (if no default defined)
176 ! -----------------------------------------------------------------------------
177 
178  IF ( defined(1) .EQV. .false. ) THEN ! No default defined
179  checksum = 0
180 
181  DO ikey = 2,nkeys
182  IF ( defined(ikey) .EQV. .true. ) THEN
183  checksum = checksum + 1
184  END IF ! defined
185  END DO ! iKey
186 
187  IF ( checksum /= pregion%specInput%nSpecies ) THEN
188  CALL errorstop(global,err_bcval_missing,__line__)
189  END IF ! checkSum
190  END IF ! defined(1)
191 
192  END IF ! pPatch%iPatchGlobal
193  END DO ! iPatch
194 
195 ! *****************************************************************************
196 ! Copy values/distribution to variables
197 ! *****************************************************************************
198 
199  DO ipatch = 1,pregion%grid%nPatches
200  ppatch => pregion%patches(ipatch)
201 
202 ! =============================================================================
203 ! Check whether this global patch exists in this region
204 ! =============================================================================
205 
206  IF ( ppatch%iPatchGlobal >= ipatchbeg .AND. &
207  ppatch%iPatchGlobal <= ipatchend ) THEN
208 
209 ! -----------------------------------------------------------------------------
210 ! Distribution
211 ! -----------------------------------------------------------------------------
212 
213  IF ( ppatch%spec%distrib == bcdat_distrib ) THEN
214  nbfacestot = ppatch%nBTrisTot + ppatch%nBQuadsTot
215 
216  ALLOCATE(ppatch%spec%vals(ppatch%spec%nData,nbfacestot), &
217  stat=errorflag)
218  global%error = errorflag
219  IF ( global%error /= 0 ) THEN
220  CALL errorstop(global,err_allocate,__line__,'pPatch%spec%vals')
221  END IF ! global
222 
223 ! ----- If not coupled, get boundary data from file ---------------------------
224 
225  IF ( ppatch%bcCoupled == bc_not_coupled ) THEN
226  CALL errorstop(global,err_reached_default,__line__)
227  ELSE ! initialize - important for GENX runs from scratch
228  DO ifc = 1,nbfacestot
229  DO ival = 1,ppatch%spec%nData
230  ppatch%spec%vals(ival,ifc) = 0.0_rfreal
231  END DO ! iVal
232  END DO ! ifc
233  END IF ! pPatch%bcCoupled
234 
235 ! -----------------------------------------------------------------------------
236 ! Constant value
237 ! -----------------------------------------------------------------------------
238 
239  ELSE
240  ALLOCATE(ppatch%spec%vals(ppatch%spec%nData,0:1), &
241  stat=errorflag)
242  global%error = errorflag
243  IF ( global%error /= 0 ) THEN
244  CALL errorstop(global,err_allocate,__line__,'pPatch%spec%vals')
245  END IF ! global%error
246 
247  DO ival = 1,ppatch%spec%nData
248  IF ( defined(1+ival) .EQV. .true. ) THEN ! Set to input
249  ppatch%spec%vals(ival,0:1) = vals(1+ival)
250  ELSE ! Set to default
251  ppatch%spec%vals(ival,0:1) = vals(1)
252  END IF ! defined
253  END DO ! iVal
254  END IF ! pPatch%spec%distrib
255  END IF ! pPatch%iPatchGlobal
256  END DO ! iPatch
257 
258 ! *****************************************************************************
259 ! Deallocate memory
260 ! *****************************************************************************
261 
262  DEALLOCATE(keys,stat=errorflag)
263  global%error = errorflag
264  IF ( global%error /= err_none ) THEN
265  CALL errorstop(global,err_deallocate,__line__,'keys')
266  END IF ! global%error
267 
268  DEALLOCATE(vals,stat=errorflag)
269  global%error = errorflag
270  IF ( global%error /= err_none ) THEN
271  CALL errorstop(global,err_deallocate,__line__,'vals')
272  END IF ! global%error
273 
274  DEALLOCATE(defined,stat=errorflag)
275  global%error = errorflag
276  IF ( global%error /= err_none ) THEN
277  CALL errorstop(global,err_deallocate,__line__,'defined')
278  END IF ! global%error
279 
280 ! *****************************************************************************
281 ! End
282 ! *****************************************************************************
283 
284  CALL deregisterfunction(global)
285 
286 END SUBROUTINE spec_rflu_readbcinjectsection
287 
288 !******************************************************************************
289 !
290 ! RCS Revision history:
291 !
292 ! $Log: SPEC_RFLU_ReadBcInjectSection.F90,v $
293 ! Revision 1.5 2008/12/06 08:44:40 mtcampbe
294 ! Updated license.
295 !
296 ! Revision 1.4 2008/11/19 22:17:53 mtcampbe
297 ! Added Illinois Open Source License/Copyright
298 !
299 ! Revision 1.3 2006/08/19 15:40:32 mparmar
300 ! Renamed patch variables
301 !
302 ! Revision 1.2 2006/04/07 15:19:25 haselbac
303 ! Removed tabs
304 !
305 ! Revision 1.1 2003/11/25 21:08:37 haselbac
306 ! Initial revision
307 !
308 !******************************************************************************
309 
310 
311 
312 
313 
314 
315 
subroutine makenumberedkeys(keys, indBegin, string, numBegin, numEnd, numSkip)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine readpatchsection(global, fileID, nvals, keys, vals, brbeg, brend, prbeg, prend, distrib, profType, fname, defined)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine spec_rflu_readbcinjectsection(pRegion)
subroutine grid(bp)
Definition: setup_py.f90:257
subroutine deregisterfunction(global)
Definition: ModError.F90:469