Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_CheckPositivity.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 variables
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! pRegion Region data
31 !
32 ! Output: None.
33 !
34 ! Notes:
35 ! 1. Compute and check pressure here because, it being computed later
36 ! through a call to MixtureProperties, a negative value would not be
37 ! detected and could cause negative pressure and temperature.
38 !
39 ! ******************************************************************************
40 !
41 ! $Id: RFLU_CheckPositivity.F90,v 1.14 2008/12/06 08:44:11 mtcampbe Exp $
42 !
43 ! Copyright: (c) 2002-2005 by the University of Illinois
44 !
45 ! ******************************************************************************
46 
47 SUBROUTINE rflu_checkpositivity(pRegion)
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 
57  USE modinterfaces, ONLY: mixtperf_g_cpr, &
59  mixtperf_r_m, &
62 
63  IMPLICIT NONE
64 
65 ! ******************************************************************************
66 ! Definitions and declarations
67 ! ******************************************************************************
68 
69 ! ==============================================================================
70 ! Arguments
71 ! ==============================================================================
72 
73  TYPE(t_region), POINTER :: pregion
74 
75 ! ==============================================================================
76 ! Locals
77 ! ==============================================================================
78 
79  CHARACTER(CHRLEN) :: rcsidentstring
80  INTEGER, PARAMETER :: max_negative_locs = 10
81  INTEGER :: icg,indcp,indmol,nlocs
82  INTEGER :: loc(max_negative_locs,min_val:max_val)
83  REAL(RFREAL) :: eo,gamma,p,rgas,rho,rrho,t,u,v,vm2,w
84  REAL(RFREAL), DIMENSION(:,:), POINTER :: cv,dv,gv
85  TYPE(t_global), POINTER :: global
86  TYPE(t_grid), POINTER :: pgrid
87 
88 ! ******************************************************************************
89 ! Start
90 ! ******************************************************************************
91 
92  rcsidentstring = '$RCSfile: RFLU_CheckPositivity.F90,v $ $Revision: 1.14 $'
93 
94  global => pregion%global
95 
96  CALL registerfunction(global,'RFLU_CheckPositivity',&
97  'RFLU_CheckPositivity.F90')
98 
99 ! ******************************************************************************
100 ! Set pointers and variables
101 ! ******************************************************************************
102 
103  pgrid => pregion%grid
104 
105  nlocs = 0
106 
107  indcp = pregion%mixtInput%indCp
108  indmol = pregion%mixtInput%indMol
109 
110 #ifdef ROCPROF
111  CALL fprofiler_begins("RFLU::CheckPositivity")
112 #endif
113 
114 ! ******************************************************************************
115 ! Loop over cells and check for positivity
116 ! ******************************************************************************
117 
118  cv => pregion%mixt%cv
119  dv => pregion%mixt%dv
120  gv => pregion%mixt%gv
121 
122  DO icg = 1,pgrid%nCells
123  rho = cv(cv_mixt_dens,icg)
124  rrho = 1.0_rfreal/rho
125  u = rrho*cv(cv_mixt_xmom,icg)
126  v = rrho*cv(cv_mixt_ymom,icg)
127  w = rrho*cv(cv_mixt_zmom,icg)
128  eo = rrho*cv(cv_mixt_ener,icg)
129 
130  rgas = mixtperf_r_m(gv(gv_mixt_mol,icg*indmol))
131  gamma = mixtperf_g_cpr(gv(gv_mixt_cp,icg*indcp),rgas)
132  vm2 = u*u + v*v + w*w
133 
134  p = mixtperf_p_deogvm2(rho,eo,gamma,vm2)
135  t = mixtperf_t_dpr(rho,p,rgas)
136 
137  IF ( (rho <= 0.0_rfreal) .OR. (p <= 0.0_rfreal) ) THEN
138  nlocs = nlocs + 1
139 
140  IF ( nlocs == 1 ) THEN
141  WRITE(stdout,'(A,1X,A)') solver_name, &
142  'Negative positive-definite variables detected!'
143  WRITE(stdout,'(A,3X,A)') solver_name,'Module: Mixture.'
144 
145  IF ( global%flowType == flow_unsteady ) THEN
146  WRITE(stdout,'(A,3X,A,1X,1PE12.5)') solver_name,'Current time:', &
147  global%currentTime
148  ELSE
149  WRITE(stdout,'(A,3X,A,1X,I6)') solver_name, &
150  'Current iteration number:', &
151  global%currentIter
152  END IF ! global%flowType
153 
154  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
155  pregion%iRegionGlobal
156  WRITE(stdout,'(A,6X,A,6(1X,A))') solver_name,'#', &
157  ' Density ', &
158  ' x-velocity ', &
159  ' y-velocity ', &
160  ' z-velocity ', &
161  ' Pressure ', &
162  ' Temperature '
163  END IF ! nLocs
164 
165  IF ( nlocs <= max_negative_locs ) THEN
166  WRITE(stdout,'(A,4X,I3,6(1X,E13.6))') solver_name,nlocs, &
167  rho,u,v,w,p,t
168  loc(nlocs,min_val:max_val) = icg
169  END IF ! nLocs
170  END IF ! cv
171  END DO ! icg
172 
173 ! ******************************************************************************
174 ! Write out message and call error handling routine
175 ! ******************************************************************************
176 
177  IF ( nlocs > 0 ) THEN
178  IF ( nlocs > max_negative_locs ) THEN
179  WRITE(stdout,'(A,3X,A,1X,I3,1X,A,1X,I9,1X,A)') solver_name, &
180  'Only wrote the first',max_negative_locs,'of',nlocs, &
181  'cells with negative positive-definite variables.'
182  CALL rflu_printlocinfo(pregion,loc,max_negative_locs, &
183  locinfo_mode_silent,output_mode_anybody)
184  ELSE
185  CALL rflu_printlocinfo(pregion,loc(1:nlocs,min_val:max_val),nlocs, &
186  locinfo_mode_silent,output_mode_anybody)
187  END IF ! nLocs
188 
189  CALL errorstop(global,err_negative_posdef,__line__)
190  END IF ! nLocs
191 
192 ! ******************************************************************************
193 ! End
194 ! ******************************************************************************
195 
196 #ifdef ROCPROF
197  CALL fprofiler_ends("RFLU::CheckPositivity")
198 #endif
199 
200  CALL deregisterfunction(global)
201 
202 END SUBROUTINE rflu_checkpositivity
203 
204 ! ******************************************************************************
205 !
206 ! RCS Revision history:
207 !
208 ! $Log: RFLU_CheckPositivity.F90,v $
209 ! Revision 1.14 2008/12/06 08:44:11 mtcampbe
210 ! Updated license.
211 !
212 ! Revision 1.13 2008/11/19 22:17:25 mtcampbe
213 ! Added Illinois Open Source License/Copyright
214 !
215 ! Revision 1.12 2006/04/07 15:19:16 haselbac
216 ! Removed tabs
217 !
218 ! Revision 1.11 2006/03/26 20:21:25 haselbac
219 ! Removed dv declaration and definition
220 !
221 ! Revision 1.10 2005/07/07 22:44:00 haselbac
222 ! Added profiling calls, cosmetics
223 !
224 ! Revision 1.9 2004/01/29 22:56:27 haselbac
225 ! Some clean-up and cosmetic changes
226 !
227 ! Revision 1.8 2004/01/11 02:06:38 jiao
228 ! Eliminated some redundant trailing spaces that made some lines too long.
229 ! This changed was needed to compile with NAG F90 compiler.
230 !
231 ! Revision 1.7 2003/12/04 03:33:53 haselbac
232 ! Clean-up and minor changes
233 !
234 ! Revision 1.6 2003/07/22 02:12:58 haselbac
235 ! Cosmetics only
236 !
237 ! Revision 1.5 2003/06/04 22:00:37 haselbac
238 ! Rewrite to be more informative
239 !
240 ! Revision 1.4 2003/05/13 23:47:21 haselbac
241 ! Added check for pressure, cosmetics
242 !
243 ! Revision 1.3 2003/04/10 14:38:24 haselbac
244 ! Changed interface statement
245 !
246 ! Revision 1.2 2003/03/15 16:48:09 haselbac
247 ! Cosmetics, adapted function calls
248 !
249 ! Revision 1.1 2002/10/27 18:55:24 haselbac
250 ! Initial revision
251 !
252 ! ******************************************************************************
253 
254 
255 
256 
257 
258 
259 
real(rfreal) function mixtperf_p_deogvm2(D, Eo, G, Vm2)
Definition: MixtPerf_P.F90:39
real(rfreal) function mixtperf_r_m(M)
Definition: MixtPerf_R.F90:54
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
*********************************************************************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
Definition: roccomf90.h:20
real(rfreal) function mixtperf_t_dpr(D, P, R)
Definition: MixtPerf_T.F90:85
subroutine rflu_printlocinfo(pRegion, locUnsorted, nLocUnsorted, locInfoMode, outputMode)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine rflu_checkpositivity(pRegion)
subroutine deregisterfunction(global)
Definition: ModError.F90:469
real(rfreal) function mixtperf_g_cpr(Cp, R)
Definition: MixtPerf_G.F90:39