67 TYPE(t_region
),
POINTER :: pregion
74 CHARACTER(CHRLEN) :: rcsidentstring
75 INTEGER :: cellindx,errorflag,faceindx,icellsspecial,icl,iloc, &
76 nvertpercell,patchindx,vertindx
79 TYPE(t_grid),
POINTER :: pgrid
80 TYPE(t_patch),
POINTER :: ppatch
86 rcsidentstring =
'$RCSfile: RFLU_GetSpecialCells.F90,v $'
88 global => pregion%global
91 'RFLU_GetSpecialCells.F90')
93 IF ( global%verbLevel > verbose_none )
THEN
94 WRITE(stdout,
'(A,1X,A)') solver_name,
'Getting special cells...'
95 WRITE(stdout,
'(A,3X,A,1X,I5.5)') solver_name,
'Global region:', &
103 pgrid => pregion%grid
106 pgrid%cellsSpecial(1:ncells_special_max) = 0
112 WRITE(stdout,
'(A,5X,A)') solver_name,
'Enter information on special cells:'
113 WRITE(stdout,
'(A,7X,A)') solver_name,
'b - cell adjacent to boundary face'
114 WRITE(stdout,
'(A,7X,A)') solver_name,
'c - single cell'
115 WRITE(stdout,
'(A,7X,A)') solver_name,
'f - cells adjacent to interior face'
116 WRITE(stdout,
'(A,7X,A)') solver_name,
'v - cells meeting at vertex'
117 WRITE(stdout,
'(A,7X,A)') solver_name,
'q - quit'
129 WRITE(stdout,
'(A,3X,A)') solver_name,
'Enter information type:'
130 READ(stdin,
'(A)') infotype
132 SELECT CASE ( infotype )
137 WRITE(stdout,
'(A,5X,A)') solver_name,
'Enter patch index:'
138 READ(stdin,*,iostat=errorflag) patchindx
140 IF ( errorflag /= err_none )
THEN
141 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
145 IF ( patchindx > 0 .AND. patchindx <= pgrid%nPatches )
THEN
146 ppatch => pregion%patches(patchindx)
148 WRITE(stdout,
'(A,5X,A)') solver_name,
'Enter face index:'
149 READ(stdin,*,iostat=errorflag) faceindx
151 IF ( errorflag /= err_none )
THEN
152 WRITE(stdout,
'(A,5X,A)') solver_name, &
153 '*** WARNING *** Invalid input.'
157 IF ( faceindx > 0 .AND. faceindx <= ppatch%nBFacesTot )
THEN
158 IF ( icellsspecial == ncells_special_max )
THEN
159 CALL
errorstop(global,err_ncells_special_max,__line__)
162 icellsspecial = icellsspecial + 1
163 pgrid%cellsSpecial(icellsspecial) = ppatch%bf2c(faceindx)
165 WRITE(stdout,
'(A,5X,A,1X,I8)') solver_name,
'Added cell:', &
166 ppatch%bf2c(faceindx)
168 WRITE(stdout,
'(A,5X,A)') solver_name, &
169 '*** WARNING *** Invalid input.'
173 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
180 WRITE(stdout,
'(A,5X,A)') solver_name,
'Enter cell index:'
181 READ(stdin,*,iostat=errorflag) cellindx
183 IF ( errorflag /= err_none )
THEN
184 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
188 IF ( cellindx > 0 .AND. cellindx <= pgrid%nCellsTot )
THEN
189 IF ( icellsspecial == ncells_special_max )
THEN
190 CALL
errorstop(global,err_ncells_special_max,__line__)
193 icellsspecial = icellsspecial + 1
194 pgrid%cellsSpecial(icellsspecial) = cellindx
196 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
203 WRITE(stdout,
'(A,5X,A)') solver_name,
'Enter interior face index:'
204 READ(stdin,*,iostat=errorflag) faceindx
206 IF ( errorflag /= err_none )
THEN
207 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
211 IF ( faceindx > 0 .AND. faceindx <= pgrid%nFacesTot )
THEN
212 IF ( icellsspecial == ncells_special_max-1 )
THEN
213 CALL
errorstop(global,err_ncells_special_max,__line__)
216 icellsspecial = icellsspecial + 1
217 pgrid%cellsSpecial(icellsspecial) = pgrid%f2c(1,faceindx)
219 icellsspecial = icellsspecial + 1
220 pgrid%cellsSpecial(icellsspecial) = pgrid%f2c(2,faceindx)
222 WRITE(stdout,
'(A,5X,A,1X,I8,1X,A,1X,I8)') solver_name, &
223 'Added cells:',pgrid%f2c(1,faceindx),
'and', &
224 pgrid%f2c(2,faceindx)
226 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
233 WRITE(stdout,
'(A,5X,A)') solver_name,
'Enter vertex index:'
234 READ(stdin,*,iostat=errorflag) vertindx
236 IF ( errorflag /= err_none )
THEN
237 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
241 IF ( vertindx > 0 .AND. vertindx <= pgrid%nVertTot )
THEN
245 IF ( pgrid%nTetsTot > 0 )
THEN
246 WRITE(stdout,
'(A,5X,A)') solver_name,
'Tetrahedra...'
250 DO icl = 1,pgrid%nTetsTot
251 v(1:nvertpercell) = pgrid%tet2v(1:nvertpercell,icl)
256 IF ( iloc /= element_not_found )
THEN
257 IF ( icellsspecial == ncells_special_max )
THEN
258 CALL
errorstop(global,err_ncells_special_max,__line__)
261 icellsspecial = icellsspecial + 1
262 pgrid%cellsSpecial(icellsspecial) = pgrid%tet2CellGlob(icl)
264 WRITE(stdout,
'(A,7X,A,1X,I8)') solver_name,
'Added cell:', &
265 pgrid%tet2CellGlob(icl)
272 IF ( pgrid%nHexsTot > 0 )
THEN
273 WRITE(stdout,
'(A,5X,A)') solver_name,
'Hexahedra...'
277 DO icl = 1,pgrid%nHexsTot
278 v(1:nvertpercell) = pgrid%hex2v(1:nvertpercell,icl)
283 IF ( iloc /= element_not_found )
THEN
284 IF ( icellsspecial == ncells_special_max )
THEN
285 CALL
errorstop(global,err_ncells_special_max,__line__)
288 icellsspecial = icellsspecial + 1
289 pgrid%cellsSpecial(icellsspecial) = pgrid%hex2CellGlob(icl)
291 WRITE(stdout,
'(A,7X,A,1X,I8)') solver_name,
'Added cell:', &
292 pgrid%hex2CellGlob(icl)
299 IF ( pgrid%nPrisTot > 0 )
THEN
300 WRITE(stdout,
'(A,5X,A)') solver_name,
'Prisms...'
304 DO icl = 1,pgrid%nPrisTot
305 v(1:nvertpercell) = pgrid%pri2v(1:nvertpercell,icl)
310 IF ( iloc /= element_not_found )
THEN
311 IF ( icellsspecial == ncells_special_max )
THEN
312 CALL
errorstop(global,err_ncells_special_max,__line__)
315 icellsspecial = icellsspecial + 1
316 pgrid%cellsSpecial(icellsspecial) = pgrid%pri2CellGlob(icl)
318 WRITE(stdout,
'(A,7X,A,1X,I8)') solver_name,
'Added cell:', &
319 pgrid%pri2CellGlob(icl)
326 IF ( pgrid%nPyrsTot > 0 )
THEN
327 WRITE(stdout,
'(A,5X,A)') solver_name,
'Pyramids...'
331 DO icl = 1,pgrid%nPyrsTot
332 v(1:nvertpercell) = pgrid%pyr2v(1:nvertpercell,icl)
337 IF ( iloc /= element_not_found )
THEN
338 IF ( icellsspecial == ncells_special_max )
THEN
339 CALL
errorstop(global,err_ncells_special_max,__line__)
342 icellsspecial = icellsspecial + 1
343 pgrid%cellsSpecial(icellsspecial) = pgrid%pyr2CellGlob(icl)
345 WRITE(stdout,
'(A,7X,A,1X,I8)') solver_name,
'Added cell:', &
346 pgrid%pyr2CellGlob(icl)
352 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
364 WRITE(stdout,
'(A,5X,A)') solver_name,
'*** WARNING *** Invalid input.'
373 pgrid%nCellsSpecial = icellsspecial
379 IF ( global%verbLevel > verbose_none )
THEN
380 WRITE(stdout,
'(A,1X,A)') solver_name,
'Getting special cells done.'
subroutine registerfunction(global, funName, fileName)
subroutine quicksortinteger(a, n)
subroutine rflu_getspecialcells(pRegion)
subroutine binarysearchinteger(a, n, v, i, j)
*********************************************************************Illinois Open Source License ****University of Illinois NCSA **Open Source License University of Illinois All rights reserved ****Developed free of to any person **obtaining a copy of this software and associated documentation to deal with the Software without including without limitation the rights to and or **sell copies of the and to permit persons to whom the **Software is furnished to do subject to the following this list of conditions and the following disclaimers ****Redistributions in binary form must reproduce the above **copyright this list of conditions and the following **disclaimers in the documentation and or other materials **provided with the distribution ****Neither the names of the Center for Simulation of Advanced the University of nor the names of its **contributors may be used to endorse or promote products derived **from this Software without specific prior written permission ****THE SOFTWARE IS PROVIDED AS 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 v
subroutine errorstop(global, errorCode, errorLine, addMessage)
subroutine deregisterfunction(global)