75 TYPE(t_region
),
POINTER :: pregion
81 CHARACTER(CHRLEN) :: rcsidentstring
82 INTEGER,
PARAMETER :: max_negative_locs = 10
83 INTEGER :: icg,indcp,indmol,nlocs
84 INTEGER :: loc(max_negative_locs,min_val:max_val)
85 REAL(RFREAL) :: bp,bt,cg2,cpgas,cpvap,cl2,cv2,cvg,cvl,cvm,cvv,eo,p,po, &
86 rgas,rho,rhoyg,rhoyl,rhoyv,ro,rrho,rvap,t,to,u,
v,vm2,w
87 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: pcv,pcvspec,pdv,pgv
89 TYPE(t_grid),
POINTER :: pgrid
95 rcsidentstring =
'$RCSfile: RFLU_CheckPositivity_GL.F90,v $'
97 global => pregion%global
100 'RFLU_CheckPositivity_GL.F90')
106 pgrid => pregion%grid
108 pcv => pregion%mixt%cv
109 pdv => pregion%mixt%dv
110 pgv => pregion%mixt%gv
113 pcvspec => pregion%spec%cv
118 indcp = pregion%mixtInput%indCp
119 indmol = pregion%mixtInput%indMol
121 ro = global%refDensityLiq
122 po = global%refPressLiq
123 to = global%refTempLiq
124 bp = global%refBetaPLiq
125 bt = global%refBetaTLiq
126 cvl = global%refCvLiq
128 rgas =
mixtperf_r_m(pregion%specInput%specType(1)%pMaterial%molw)
129 cvg =
mixtperf_cv_cpr(pregion%specInput%specType(1)%pMaterial%spht,rgas)
131 rvap =
mixtperf_r_m(pregion%specInput%specType(2)%pMaterial%molw)
132 cvv =
mixtperf_cv_cpr(pregion%specInput%specType(2)%pMaterial%spht,rvap)
138 DO icg = 1,pgrid%nCells
139 rho = pcv(cv_mixt_dens,icg)
140 rrho = 1.0_rfreal/rho
141 rhoyg = pcvspec(1,icg)
142 rhoyv = pcvspec(2,icg)
143 rhoyl = rho - rhoyg - rhoyv
145 u = rrho*pcv(cv_mixt_xmom,icg)
146 v = rrho*pcv(cv_mixt_ymom,icg)
147 w = rrho*pcv(cv_mixt_zmom,icg)
148 eo = rrho*pcv(cv_mixt_ener,icg)
150 vm2 = u*u +
v*
v + w*w
151 cvm = (rhoyl*cvl + rhoyv*cvv + rhoyg*cvg)/rho
158 p =
mixtgasliq_p(rhoyl,rhoyv,rhoyg,cl2,cv2,cg2,rho,ro,po,to,bp,bt,t)
160 IF ( (rho <= 0.0_rfreal) .OR. (p <= 0.0_rfreal) )
THEN
163 IF ( nlocs == 1 )
THEN
164 WRITE(stdout,
'(A,1X,A)') solver_name, &
165 'Negative positive-definite variables detected!'
166 WRITE(stdout,
'(A,3X,A)') solver_name,
'Module: Mixture.'
168 IF ( global%flowType == flow_unsteady )
THEN
169 WRITE(stdout,
'(A,3X,A,1X,1PE12.5)') solver_name,
'Current time:', &
172 WRITE(stdout,
'(A,3X,A,1X,I6)') solver_name, &
173 'Current iteration number:', &
177 WRITE(stdout,
'(A,3X,A,1X,I5.5)') solver_name,
'Global region:', &
178 pregion%iRegionGlobal
179 WRITE(stdout,
'(A,6X,A,6(1X,A))') solver_name,
'#', &
188 IF ( nlocs <= max_negative_locs )
THEN
189 WRITE(stdout,
'(A,4X,I3,6(1X,E13.6))') solver_name,nlocs, &
191 loc(nlocs,min_val:max_val) = icg
200 IF ( nlocs > 0 )
THEN
201 IF ( nlocs > max_negative_locs )
THEN
202 WRITE(stdout,
'(A,3X,A,1X,I3,1X,A,1X,I9,1X,A)') solver_name, &
203 'Only wrote the first',max_negative_locs,
'of',nlocs, &
204 'cells with negative positive-definite variables.'
206 locinfo_mode_silent,output_mode_anybody)
209 locinfo_mode_silent,output_mode_anybody)
212 CALL
errorstop(global,err_negative_posdef,__line__)
real(rfreal) function mixtperf_r_m(M)
subroutine registerfunction(global, funName, fileName)
real(rfreal) function mixtgasliq_p(DYl, DYv, DYg, Cl2, Cv2, Cg2, D, Dz, Po, To, Bp, Bt, T)
*********************************************************************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
real(rfreal) function mixtperf_c2_grt(G, R, T)
real(rfreal) function mixtliq_c2_bp(Bp)
subroutine rflu_printlocinfo(pRegion, locUnsorted, nLocUnsorted, locInfoMode, outputMode)
subroutine rflu_checkpositivity_gl(pRegion)
subroutine errorstop(global, errorCode, errorLine, addMessage)
real(rfreal) function mixtperf_t_cveovm2(Cv, Eo, Vm2)
subroutine deregisterfunction(global)
real(rfreal) function mixtperf_cv_cpr(Cp, R)