Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
INRT_ReadScouring.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: Reads in information related to the interaction Scouring
26 !
27 ! Description: none.
28 !
29 ! Input: regions = data of all regions
30 !
31 ! Output: fills user data into region%inrtInput%inrts
32 !
33 ! Notes: none.
34 !
35 !******************************************************************************
36 !
37 ! $Id: INRT_ReadScouring.F90,v 1.3 2008/12/06 08:44:32 mtcampbe Exp $
38 !
39 ! Copyright: (c) 2003 by the University of Illinois
40 !
41 !******************************************************************************
42 
43 SUBROUTINE inrt_readscouring( regions )
44 
45  USE moddatatypes
46  USE moddatastruct, ONLY : t_region
47  USE modglobal, ONLY : t_global
49  USE moderror
50  USE modparameters
52 
53 #ifdef RFLO
55 #endif
56 #ifdef RFLU
57  USE modinterfaces, ONLY : readsection
58 #endif
60 
63  IMPLICIT NONE
64 
65 ! ... parameters
66  TYPE(t_region), POINTER :: regions(:)
67 
68 ! ... loop variables
69  INTEGER :: ireg,ipeul,iplag,iedge
70 
71 ! ... local variables
72  INTEGER, PARAMETER :: nkeys_max = 40
73  INTEGER, PARAMETER :: npeul_max = 10
74 
75  CHARACTER(CHRLEN) :: rcsidentstring
76  CHARACTER(CHRLEN) :: keys(nkeys_max)
77 
78  INTEGER :: brbeg,brend
79  INTEGER :: nplag,npeul
80  INTEGER :: nfixedimplkeys,nfixednodekeys,nkeys
81  INTEGER :: ind,indplag0,indpeul0
82  INTEGER :: ikey,ikeyused,ikeycoef0,ikeynode0,ikeyplagactv,ikeyplagperm
83  INTEGER :: ikeypeulactv0,ikeypeulperm0,ikeyactv,ikeyperm
84 
85  LOGICAL :: defined(nkeys_max)
86 
87  REAL(RFREAL) :: coef
88  REAL(RFREAL) :: vals(nkeys_max)
89 
90  TYPE(t_inrt_input), POINTER :: input
91  TYPE(t_inrt_interact), POINTER :: inrt
92  TYPE(t_global), POINTER :: global
93 
94 !******************************************************************************
95 
96  rcsidentstring = '$RCSfile: INRT_ReadScouring.F90,v $ $Revision: 1.3 $'
97 
98  global => regions(1)%global
99 
100  CALL registerfunction( global,'INRT_ReadScouring',&
101  'INRT_ReadScouring.F90' )
102 
103 ! begin -----------------------------------------------------------------------
104 
105 ! define implementation-dependent keys
106 
107  ikeyused = 1
108  nfixedimplkeys = 1
109 
110  keys(ikeyused) = 'USED'
111 
112  ikeycoef0 = nfixedimplkeys
113 
114  CALL makenumberedkeys(keys,ikeycoef0+1,'COEF',1,npeul_max,1)
115 
116 ! define Node keys
117 
118  ikeynode0 = ikeycoef0 + npeul_max
119  ikeyplagactv = ikeynode0 + 1
120  ikeyplagperm = ikeynode0 + 2
121  nfixednodekeys = 2
122 
123  keys(ikeyplagactv) = 'PLAG_ACTV'
124  keys(ikeyplagperm) = 'PLAG_PERM'
125 
126  ikeypeulactv0 = ikeynode0 + nfixednodekeys
127  ikeypeulperm0 = ikeypeulactv0 + npeul_max
128 
129 #ifdef RFLO
130  CALL makenumberedkeys(keys,ikeypeulactv0+1,'PEUL',1,npeul_max,1)
131  CALL makenumberedkeys(keys,ikeypeulperm0+1,'PEUL',1,npeul_max,1)
132 #endif
133 #ifdef RFLU
134  CALL makenumberedkeys(keys,ikeypeulactv0+1,'SPEC',1,npeul_max,1)
135  CALL makenumberedkeys(keys,ikeypeulperm0+1,'SPEC',1,npeul_max,1)
136 #endif
137 
138  DO ipeul=1,npeul_max
139  keys(ikeypeulactv0+ipeul) = trim(keys(ikeypeulactv0+ipeul))//'_ACTV'
140  keys(ikeypeulperm0+ipeul) = trim(keys(ikeypeulperm0+ipeul))//'_PERM'
141  END DO ! iPeul
142 
143  nkeys = ikeypeulperm0 + npeul_max
144 
145  IF (nkeys > nkeys_max) CALL errorstop( global,err_exceeds_decl_mem,__line__ )
146 
147 ! Read interaction section from input file
148 
149 #ifdef RFLO
150  CALL readregionsection( global,if_input,nkeys,keys,vals,brbeg,brend,defined )
151 #endif
152 #ifdef RFLU
153  CALL readsection( global,if_input,nkeys,keys,vals,defined )
154  brbeg = lbound(regions,1)
155  brend = ubound(regions,1)
156 #endif
157 
158  DO ireg=brbeg,brend
159 
160  input => regions(ireg)%inrtInput
161  inrt => input%inrts(inrt_type_scouring)
162 
163 ! - Check that INRT_DEFAULT section has been read, and that interaction has not
164 
165  IF (.NOT. input%defaultRead) &
166  CALL errorstop( global,err_inrt_defunread,__line__ )
167 
168  IF (inrt%used) CALL errorstop( global,err_inrt_read,__line__ )
169 
170 ! - Use local variables for some useful quantities
171 
172  nplag = input%nPlag
173  npeul = input%nPeul
174 
175  IF (npeul > npeul_max) &
176  CALL errorstop( global,err_exceeds_decl_mem,__line__ )
177 
178  indplag0 = input%indPlag0
179  indpeul0 = input%indPeul0
180 
181 ! - Check if interaction is used
182 
183  inrt%used = .true. ! used by default when its section appears
184 
185  IF (defined(ikeyused)) THEN
186  IF (nint(vals(ikeyused)) == 0) inrt%used = .false.
187  END IF ! defined(iKeyUsed)
188 
189  IF (nplag < 1) inrt%used = .false. ! cannot occur without particles
190  IF (npeul < 1) inrt%used = .false. ! cannot occur without smoke
191 
192  IF (.NOT. inrt%used) cycle ! do not bother with unused interactions
193 
194 ! - Define interaction (using any relevant information from input deck)
195 
196  CALL inrt_definescouring(regions(ireg))
197 
198 ! - Check for data (scouring coefficients)
199 
200  DO iedge = 1,inrt%nEdges
201 
202  ipeul = inrt%edges(iedge)%iNode(1) - indpeul0
203 
204  IF (ipeul < 1 .OR. ipeul > npeul) &
205  CALL errorstop( global,err_inrt_indexrange,__line__ )
206 
207  ikey = ikeycoef0 + ipeul
208  ind = inrt_dat_scouring_coef0 + iedge
209 
210  coef = 1._rfreal ! default scouring coefficient
211 
212  IF (defined(ikey)) coef = vals(ikey)
213 
214  IF (coef < 0._rfreal) CALL errorstop( global,err_inrt_badval,__line__ )
215 
216  inrt%data(ind) = coef
217 
218  END DO ! iEdge
219 
220 ! - Check for Lagrangian particle controls
221 
222  DO iplag=1,nplag+1
223 
224  ind = indplag0 + iplag
225 
226  IF (defined(ikeyplagactv)) &
227  CALL inrt_setactiveness(global,vals(ikeyplagactv), &
228  inrt%activeness(ind))
229 
230  IF (defined(ikeyplagperm)) &
231  CALL inrt_setpermission(global,vals(ikeyplagperm), &
232  inrt%permission(ind))
233 
234  END DO ! iPlag
235 
236 ! - Check for Smoke controls
237 
238  DO ipeul = 1,npeul
239 
240  ikeyactv = ikeypeulactv0 + ipeul
241  ikeyperm = ikeypeulperm0 + ipeul
242  ind = indpeul0 + ipeul
243 
244  IF (defined(ikeyactv)) &
245  CALL inrt_setactiveness(global,vals(ikeyactv), &
246  inrt%activeness(ind))
247 
248  IF (defined(ikeyperm)) &
249  CALL inrt_setpermission(global,vals(ikeyperm), &
250  inrt%permission(ind))
251 
252  END DO ! iPeul
253 
254 ! - Determine permission Tokens
255 
256  CALL inrt_determinetokens(regions(ireg),inrt)
257 
258  END DO ! iReg
259 
260 ! finalize --------------------------------------------------------------------
261 
262  CALL deregisterfunction( global )
263 
264 END SUBROUTINE inrt_readscouring
265 
266 !******************************************************************************
267 !
268 ! RCS Revision history:
269 !
270 ! $Log: INRT_ReadScouring.F90,v $
271 ! Revision 1.3 2008/12/06 08:44:32 mtcampbe
272 ! Updated license.
273 !
274 ! Revision 1.2 2008/11/19 22:17:44 mtcampbe
275 ! Added Illinois Open Source License/Copyright
276 !
277 ! Revision 1.1 2004/12/01 21:56:40 fnajjar
278 ! Initial revision after changing case
279 !
280 ! Revision 1.7 2004/07/23 22:43:17 jferry
281 ! Integrated rocspecies into rocinteract
282 !
283 ! Revision 1.6 2004/03/05 22:09:03 jferry
284 ! created global variables for peul, plag, and inrt use
285 !
286 ! Revision 1.5 2004/03/02 21:49:23 jferry
287 ! Added inrtUsed flag to mixture data structure
288 !
289 ! Revision 1.4 2003/04/02 22:32:04 jferry
290 ! codified Activeness and Permission structures for rocinteract
291 !
292 ! Revision 1.3 2003/03/24 23:30:52 jferry
293 ! overhauled rocinteract to allow interaction design to use user input
294 !
295 ! Revision 1.2 2003/03/11 16:09:39 jferry
296 ! Added comments
297 !
298 ! Revision 1.1 2003/03/04 22:12:35 jferry
299 ! Initial import of Rocinteract
300 !
301 !******************************************************************************
302 
303 
304 
305 
306 
307 
308 
subroutine makenumberedkeys(keys, indBegin, string, numBegin, numEnd, numSkip)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine inrt_determinetokens(region, inrt)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE brbeg
subroutine inrt_readscouring(regions)
subroutine inrt_definescouring(region)
subroutine input(X, NNODE, NDC, NCELL, NFCE, NBPTS, NBFACE, ITYP, NPROP, XBNDY, XFAR, YFAR, ZFAR)
subroutine inrt_setactiveness(global, val, actv)
subroutine readsection(global, fileID, nvals, keys, vals, defined)
subroutine readregionsection(global, fileID, nvals, keys, vals, brbeg, brend, defined)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine inrt_setpermission(global, val, perm)