Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ScalarCheckPositivity.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: Check for posivity of scalar variables
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! pRegion Region data
31 ! moduleType Type of module
32 ! nVarScal Number of scalar variables
33 ! cvScal Conserved scalar variables
34 !
35 ! Output: None.
36 !
37 ! Notes: None.
38 !
39 !******************************************************************************
40 !
41 ! $Id: RFLU_ScalarCheckPositivity.F90,v 1.4 2008/12/06 08:44:12 mtcampbe Exp $
42 !
43 ! Copyright: (c) 2002-2004 by the University of Illinois
44 !
45 !******************************************************************************
46 
47 SUBROUTINE rflu_scalarcheckpositivity(pRegion,moduleType,nVarScal,cvScal)
48 
49  USE moddatatypes
50  USE moderror
51  USE modglobal, ONLY: t_global
52  USE moddatastruct, ONLY: t_region
53  USE modgrid, ONLY: t_grid
54  USE modparameters
55  USE modmpi
56 
58 
59  IMPLICIT NONE
60 
61 ! *****************************************************************************
62 ! Definitions and declarations
63 ! *****************************************************************************
64 
65 ! =============================================================================
66 ! Arguments
67 ! =============================================================================
68 
69  INTEGER, INTENT(IN) :: moduletype,nvarscal
70  REAL(RFREAL), DIMENSION(:,:), INTENT(IN) :: cvscal
71  TYPE(t_region), POINTER :: pregion
72 
73 ! =============================================================================
74 ! Locals
75 ! =============================================================================
76 
77  CHARACTER(CHRLEN) :: rcsidentstring
78  INTEGER, PARAMETER :: max_negative_locs = 10
79  INTEGER :: icg,ivarscal,nlocs
80  INTEGER :: loc(max_negative_locs,min_val:max_val)
81  TYPE(t_global), POINTER :: global
82  TYPE(t_grid), POINTER :: pgrid
83 
84 ! *****************************************************************************
85 ! Start
86 ! *****************************************************************************
87 
88  rcsidentstring = '$RCSfile: RFLU_ScalarCheckPositivity.F90,v $ $Revision: 1.4 $'
89 
90  global => pregion%global
91 
92  CALL registerfunction(global,'RFLU_ScalarCheckPositivity',&
93  'RFLU_ScalarCheckPositivity.F90')
94 
95 ! *****************************************************************************
96 ! Set pointers and variables
97 ! *****************************************************************************
98 
99  pgrid => pregion%grid
100 
101  nlocs = 0
102 
103 ! *****************************************************************************
104 ! Loop over cells and check for positivity
105 ! *****************************************************************************
106 
107  cellloop: DO icg = 1,pgrid%nCells
108  varloop: DO ivarscal = 1,nvarscal
109  IF ( cvscal(ivarscal,icg) < 0.0_rfreal ) THEN
110  nlocs = nlocs + 1
111 
112  IF ( nlocs == 1 ) THEN
113  WRITE(stdout,'(A,1X,A)') solver_name, &
114  'Negative positive-definite variables detected!'
115 
116  SELECT CASE ( moduletype )
117  CASE ( ftype_spec )
118  WRITE(stdout,'(A,3X,A)') solver_name,'Module: Species.'
119  CASE default
120  CALL errorstop(global,err_reached_default,__line__)
121  END SELECT ! moduleType
122 
123  IF ( global%flowType == flow_unsteady ) THEN
124  WRITE(stdout,'(A,3X,A,1X,1PE12.5)') solver_name,'Current time:', &
125  global%currentTime
126  ELSE
127  WRITE(stdout,'(A,3X,A,1X,I6)') solver_name, &
128  'Current iteration number:', &
129  global%currentIter
130  END IF ! global%flowType
131 
132  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
133  pregion%iRegionGlobal
134 ! WRITE(STDOUT,'(A,6X,A,6(1X,A))') SOLVER_NAME,'#', &
135 ! ' Density ', &
136 ! ' x-velocity ', &
137 ! ' y-velocity ', &
138 ! ' z-velocity ', &
139 ! ' Pressure ', &
140 ! ' Temperature '
141  END IF ! nLocs
142 
143  IF ( nlocs <= max_negative_locs ) THEN
144  WRITE(stdout,'(A,4X,I3,6(1X,E13.6))') solver_name,nlocs, &
145  cvscal(1:nvarscal,icg)
146 
147  loc(nlocs,min_val:max_val) = icg
148 
149  EXIT varloop ! NOTE this EXIT statement
150  END IF ! nLocs
151  END IF ! cvScal
152  END DO varloop
153  END DO cellloop
154 
155 ! *****************************************************************************
156 ! Write out message and call error handling routine
157 ! *****************************************************************************
158 
159  IF ( nlocs > 0 ) THEN
160  IF ( nlocs > max_negative_locs ) THEN
161  WRITE(stdout,'(A,3X,A,1X,I3,1X,A,1X,I9,1X,A)') solver_name, &
162  'Only wrote the first',max_negative_locs,'of',nlocs, &
163  'cells with negative positive-definite variables.'
164  CALL rflu_printlocinfo(pregion,loc,max_negative_locs, &
165  locinfo_mode_silent,output_mode_anybody)
166  ELSE
167  CALL rflu_printlocinfo(pregion,loc(1:nlocs,min_val:max_val),nlocs, &
168  locinfo_mode_silent,output_mode_anybody)
169  END IF ! nLocs
170 
171  CALL errorstop(global,err_negative_posdef,__line__)
172  END IF ! nLocs
173 
174 ! *****************************************************************************
175 ! End
176 ! *****************************************************************************
177 
178  CALL deregisterfunction(global)
179 
180 END SUBROUTINE rflu_scalarcheckpositivity
181 
182 !******************************************************************************
183 !
184 ! RCS Revision history:
185 !
186 ! $Log: RFLU_ScalarCheckPositivity.F90,v $
187 ! Revision 1.4 2008/12/06 08:44:12 mtcampbe
188 ! Updated license.
189 !
190 ! Revision 1.3 2008/11/19 22:17:26 mtcampbe
191 ! Added Illinois Open Source License/Copyright
192 !
193 ! Revision 1.2 2006/04/07 15:19:16 haselbac
194 ! Removed tabs
195 !
196 ! Revision 1.1 2004/01/29 22:56:05 haselbac
197 ! Initial revision
198 !
199 !******************************************************************************
200 
201 
202 
203 
204 
205 
206 
subroutine rflu_scalarcheckpositivity(pRegion, moduleType, nVarScal, cvScal)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine rflu_printlocinfo(pRegion, locUnsorted, nLocUnsorted, locInfoMode, outputMode)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469