Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
SPEC_RFLU_ReadBcFarfSection.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 farfield 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_ReadBcFarfSection.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_readbcfarfsection(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,ikey,ipatch,ipatchbeg,ipatchend, &
81  ireg,ival,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_ReadBcFarfSection.F90,v $ $Revision: 1.5 $'
92 
93  global => pregion%global
94 
95  CALL registerfunction(global,'SPEC_RFLU_ReadBcFarfSection',&
96  'SPEC_RFLU_ReadBcFarfSection.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
161 ! -----------------------------------------------------------------------------
162 
163  ppatch%spec%nData = pregion%specInput%nSpecies
164  ppatch%spec%nSwitches = 0
165  ppatch%spec%distrib = distrib
166 
167 ! -----------------------------------------------------------------------------
168 ! Check whether all values defined (if no default defined)
169 ! -----------------------------------------------------------------------------
170 
171  IF ( defined(1) .EQV. .false. ) THEN ! No default defined
172  checksum = 0
173 
174  DO ikey = 2,nkeys
175  IF ( defined(ikey) .EQV. .true. ) THEN
176  checksum = checksum + 1
177  END IF ! defined
178  END DO ! iKey
179 
180  IF ( checksum /= pregion%specInput%nSpecies ) THEN
181  CALL errorstop(global,err_bcval_missing,__line__)
182  END IF ! checkSum
183  END IF ! defined(1)
184 
185  END IF ! pPatch%iPatchGlobal
186  END DO ! iPatch
187 
188 ! *****************************************************************************
189 ! Copy values/distribution to variables
190 ! *****************************************************************************
191 
192  DO ipatch = 1,pregion%grid%nPatches
193  ppatch => pregion%patches(ipatch)
194 
195 ! =============================================================================
196 ! Check whether this global patch exists in this region
197 ! =============================================================================
198 
199  IF ( ppatch%iPatchGlobal >= ipatchbeg .AND. &
200  ppatch%iPatchGlobal <= ipatchend ) THEN
201 
202 ! -----------------------------------------------------------------------------
203 ! Distribution from file
204 ! -----------------------------------------------------------------------------
205 
206  IF ( ppatch%spec%distrib == bcdat_distrib ) THEN
207 
208 ! TO DO
209 ! Reading of data from file needs to be coded
210 ! END TO DO
211 
212 ! -----------------------------------------------------------------------------
213 ! Constant value
214 ! -----------------------------------------------------------------------------
215 
216  ELSE
217  ALLOCATE(ppatch%spec%vals(ppatch%spec%nData,0:1), &
218  stat=errorflag)
219  global%error = errorflag
220  IF ( global%error /= 0 ) THEN
221  CALL errorstop(global,err_allocate,__line__,'pPatch%spec%vals')
222  END IF ! global%error
223 
224  DO ival = 1,ppatch%spec%nData
225  IF ( defined(1+ival) .EQV. .true. ) THEN ! Set to input
226  ppatch%spec%vals(ival,0:1) = vals(1+ival)
227  ELSE ! Set to input
228  ppatch%spec%vals(ival,0:1) = vals(1)
229  END IF ! defined
230  END DO ! iVal
231  END IF ! pPatch%spec%distrib
232  END IF ! pPatch%iPatchGlobal
233  END DO ! iPatch
234 
235 ! *****************************************************************************
236 ! Deallocate memory
237 ! *****************************************************************************
238 
239  DEALLOCATE(keys,stat=errorflag)
240  global%error = errorflag
241  IF ( global%error /= err_none ) THEN
242  CALL errorstop(global,err_deallocate,__line__,'keys')
243  END IF ! global%error
244 
245  DEALLOCATE(vals,stat=errorflag)
246  global%error = errorflag
247  IF ( global%error /= err_none ) THEN
248  CALL errorstop(global,err_deallocate,__line__,'vals')
249  END IF ! global%error
250 
251  DEALLOCATE(defined,stat=errorflag)
252  global%error = errorflag
253  IF ( global%error /= err_none ) THEN
254  CALL errorstop(global,err_deallocate,__line__,'defined')
255  END IF ! global%error
256 
257 ! *****************************************************************************
258 ! End
259 ! *****************************************************************************
260 
261  CALL deregisterfunction(global)
262 
263 END SUBROUTINE spec_rflu_readbcfarfsection
264 
265 !******************************************************************************
266 !
267 ! RCS Revision history:
268 !
269 ! $Log: SPEC_RFLU_ReadBcFarfSection.F90,v $
270 ! Revision 1.5 2008/12/06 08:44:40 mtcampbe
271 ! Updated license.
272 !
273 ! Revision 1.4 2008/11/19 22:17:53 mtcampbe
274 ! Added Illinois Open Source License/Copyright
275 !
276 ! Revision 1.3 2006/08/19 15:40:30 mparmar
277 ! Renamed patch variables
278 !
279 ! Revision 1.2 2006/04/07 15:19:25 haselbac
280 ! Removed tabs
281 !
282 ! Revision 1.1 2003/11/25 21:08:37 haselbac
283 ! Initial revision
284 !
285 !******************************************************************************
286 
287 
288 
289 
290 
291 
292 
subroutine makenumberedkeys(keys, indBegin, string, numBegin, numEnd, numSkip)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine spec_rflu_readbcfarfsection(pRegion)
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 grid(bp)
Definition: setup_py.f90:257
subroutine deregisterfunction(global)
Definition: ModError.F90:469