Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_ModCheckVars.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: Suite of routines to check validity and positivy of PLAG variables.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: PLAG_ModCheckVars.F90,v 1.7 2008/12/06 08:44:34 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2005 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE plag_modcheckvars
40 
41  USE modglobal, ONLY: t_global
42  USE moddatatypes
43  USE modparameters
44  USE moderror
45  USE moddatastruct, ONLY: t_region
46  USE modpartlag, ONLY: t_plag
47  USE modmpi
48 
49  USE plag_modparameters
50 
51  USE modtools, ONLY: isnan
52 
53  IMPLICIT NONE
54 
55  PRIVATE
56  PUBLIC :: plag_checkpositivity, &
57  plag_checkvalidity
58 
59 ! ******************************************************************************
60 ! Declarations and definitions
61 ! ******************************************************************************
62 
63  CHARACTER(CHRLEN) :: &
64  RCSIdentString = '$RCSfile: PLAG_ModCheckVars.F90,v $ $Revision: 1.7 $'
65 
66 ! ******************************************************************************
67 ! Routines
68 ! ******************************************************************************
69 
70  CONTAINS
71 
72 
73 
74 
75 
76 
77 ! ******************************************************************************
78 ! Purpose: Check for posivity of variables
79 !
80 ! Description: None.
81 !
82 ! Input:
83 ! pRegion Region data
84 !
85 ! Output: None.
86 !
87 ! Notes:
88 ! 1. dv field has not been updated when this check is done. However,
89 ! the trap will be quite helpful.
90 !
91 ! ******************************************************************************
92 
93  SUBROUTINE plag_checkpositivity(pRegion)
94 
95  IMPLICIT NONE
96 
97 ! ******************************************************************************
98 ! Definitions and declarations
99 ! ******************************************************************************
100 
101 ! ==============================================================================
102 ! Arguments
103 ! ==============================================================================
104 
105  TYPE(t_region), POINTER :: pregion
106 
107 ! ==============================================================================
108 ! Locals
109 ! ==============================================================================
110 
111  CHARACTER(CHRLEN) :: rcsidentstring
112 
113  INTEGER, PARAMETER :: max_negative_locs = 10
114  INTEGER :: icg,idini,ipcl,nlocs,npcls,regini,stat
115 #ifdef RFLO
116  INTEGER :: ilev
117 #endif
118  INTEGER :: loc(max_negative_locs,min_val:max_val)
119  INTEGER, DIMENSION(:,:), POINTER :: paiv
120 
121  REAL(RFREAL) :: diam,ener,mass,temp,xpos,ypos,zpos
122  REAL(RFREAL), DIMENSION(:,:), POINTER :: pcv,pdv
123 
124  TYPE(t_global), POINTER :: global
125  TYPE(t_plag), POINTER :: pplag
126 
127 ! ******************************************************************************
128 ! Start
129 ! ******************************************************************************
130 
131  global => pregion%global
132 
133  CALL registerfunction(global,'PLAG_CheckPositivity',&
134  'PLAG_ModCheckVars.F90')
135 
136 ! ******************************************************************************
137 ! Set pointers and variables
138 ! ******************************************************************************
139 
140 #ifdef RFLO
141  ilev = pregion%currLevel
142  pplag => pregion%levels(ilev)%plag
143 #endif
144 
145 #ifdef RFLU
146  pplag => pregion%plag
147 #endif
148 
149  pcv => pplag%cv
150  pdv => pplag%dv
151  paiv => pplag%aiv
152 
153  npcls = pplag%nPcls
154  nlocs = 0
155 
156 ! ******************************************************************************
157 ! Loop over particles and check for positivity
158 ! ******************************************************************************
159 
160  DO ipcl = 1,npcls
161  mass = sum( pcv(pplag%cvPlagMass(:),ipcl) )
162  ener = pcv(cv_plag_ener,ipcl)
163  diam = pdv(dv_plag_diam,ipcl)
164  temp = pdv(dv_plag_temp,ipcl)
165  xpos = pcv(cv_plag_xpos,ipcl)
166  ypos = pcv(cv_plag_ypos,ipcl)
167  zpos = pcv(cv_plag_zpos,ipcl)
168 
169  icg = paiv(aiv_plag_icells,ipcl)
170  idini = paiv(aiv_plag_pidini,ipcl)
171  regini = paiv(aiv_plag_regini,ipcl)
172  stat = paiv(aiv_plag_status,ipcl)
173 
174  IF ( stat /= plag_status_keep) cycle
175 
176  IF ( (mass <= 0.0_rfreal) .OR. (ener <= 0.0_rfreal) ) THEN
177  nlocs = nlocs + 1
178 
179  IF ( nlocs == 1 ) THEN
180  WRITE(stdout,'(A,1X,A)') solver_name, &
181  'Negative positive-definite variables detected!'
182  WRITE(stdout,'(A,3X,A)') solver_name,'Module: Lagrangian Particle (PLAG).'
183 
184  WRITE(stdout,'(A,3X,A,1X,1PE12.5)') solver_name,'Current time:', &
185  global%currentTime
186 
187  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
188  pregion%iRegionGlobal
189  WRITE(stdout,'(A,6X,A,11(1X,A))') solver_name,'#', &
190  ' iPcl ', &
191  ' idIni ', &
192  ' RegIni ', &
193  ' icg ', &
194  ' Mass ', &
195  ' x-location ', &
196  ' y-location ', &
197  ' z-Location ', &
198  ' Energy ', &
199  ' Diameter '
200  END IF ! nLocs
201 
202  IF ( nlocs <= max_negative_locs ) THEN
203  WRITE(stdout,'(A,4X,4(1X,I8),6(1X,E13.6))') solver_name,ipcl, &
204  idini,regini,icg, &
205  mass,xpos,ypos,zpos, &
206  ener,diam
207  loc(nlocs,min_val:max_val) = ipcl
208  END IF ! nLocs
209  END IF ! cv
210  END DO ! iPcl
211 
212 ! ******************************************************************************
213 ! Write out message and call error handling routine
214 ! ******************************************************************************
215 
216  IF ( nlocs > 0 ) THEN
217  IF ( nlocs > max_negative_locs ) THEN
218  WRITE(stdout,'(A,3X,A,1X,I3,1X,A,1X,I9,1X,A)') solver_name, &
219  'Only wrote the first',max_negative_locs,'of',nlocs, &
220  'particles with negative positive-definite variables.'
221  END IF ! nLocs
222 
223  CALL errorstop(global,err_negative_posdef,__line__)
224  END IF ! nLocs
225 
226 ! ******************************************************************************
227 ! End
228 ! ******************************************************************************
229 
230  CALL deregisterfunction(global)
231 
232  END SUBROUTINE plag_checkpositivity
233 
234 
235 
236 
237 
238 
239 ! ******************************************************************************
240 ! Purpose: Check validity of variables
241 !
242 ! Description: None.
243 !
244 ! Input:
245 ! pRegion Region data
246 !
247 ! Output: None.
248 !
249 ! Notes:
250 ! 1. dv field has not been updated when this check is done. However,
251 ! the trap will be quite helpful.
252 !
253 ! ******************************************************************************
254 
255  SUBROUTINE plag_checkvalidity(pRegion)
256 
257  IMPLICIT NONE
258 
259 ! ******************************************************************************
260 ! Definitions and declarations
261 ! ******************************************************************************
262 
263 ! ==============================================================================
264 ! Arguments
265 ! ==============================================================================
266 
267  TYPE(t_region), POINTER :: pregion
268 
269 ! ==============================================================================
270 ! Locals
271 ! ==============================================================================
272 
273  CHARACTER(CHRLEN) :: rcsidentstring
274  INTEGER, PARAMETER :: max_invalid_locs = 10
275  INTEGER :: icg,idini,ipcl,nlocs,npcls,regini,stat
276 #ifdef RFLO
277  INTEGER :: ilev
278 #endif
279  INTEGER :: loc(max_invalid_locs,min_val:max_val)
280  INTEGER, DIMENSION(:,:), POINTER :: paiv
281 
282  REAL(RFREAL) :: diam,ener,mass,temp,xmom,xpos,ymom,ypos,zmom,zpos
283  REAL(RFREAL), DIMENSION(:,:), POINTER :: pcv,pdv
284 
285  TYPE(t_global), POINTER :: global
286  TYPE(t_plag), POINTER :: pplag
287 
288 ! ******************************************************************************
289 ! Start
290 ! ******************************************************************************
291 
292  global => pregion%global
293 
294  CALL registerfunction(global,'PLAG_CheckValidity',&
295  'PLAG_ModCheckVars.F90')
296 
297 ! ******************************************************************************
298 ! Set pointers and variables
299 ! ******************************************************************************
300 
301 #ifdef RFLO
302  ilev = pregion%currLevel
303  pplag => pregion%levels(ilev)%plag
304 #endif
305 
306 #ifdef RFLU
307  pplag => pregion%plag
308 #endif
309 
310  pcv => pplag%cv
311  pdv => pplag%dv
312  paiv => pplag%aiv
313 
314  npcls = pplag%nPcls
315  nlocs = 0
316 
317 ! ******************************************************************************
318 ! Loop over particles and check for validity
319 ! ******************************************************************************
320 
321  DO ipcl = 1,npcls
322  mass = sum( pcv(pplag%cvPlagMass(:),ipcl) )
323  xmom = pcv(cv_plag_xmom,ipcl)
324  ymom = pcv(cv_plag_ymom,ipcl)
325  zmom = pcv(cv_plag_zmom,ipcl)
326  ener = pcv(cv_plag_ener,ipcl)
327  diam = pdv(dv_plag_diam,ipcl)
328  temp = pdv(dv_plag_temp,ipcl)
329  xpos = pcv(cv_plag_xpos,ipcl)
330  ypos = pcv(cv_plag_ypos,ipcl)
331  zpos = pcv(cv_plag_zpos,ipcl)
332 
333  icg = paiv(aiv_plag_icells,ipcl)
334  idini = paiv(aiv_plag_pidini,ipcl)
335  regini = paiv(aiv_plag_regini,ipcl)
336  stat = paiv(aiv_plag_status,ipcl)
337 
338  IF ( stat /= plag_status_keep) cycle
339 
340  IF ( (isnan(mass) .EQV. .true.) .OR. &
341  (isnan(xmom) .EQV. .true.) .OR. &
342  (isnan(ymom) .EQV. .true.) .OR. &
343  (isnan(zmom) .EQV. .true.) .OR. &
344  (isnan(ener) .EQV. .true.) .OR. &
345  (isnan(xpos) .EQV. .true.) .OR. &
346  (isnan(ypos) .EQV. .true.) .OR. &
347  (isnan(zpos) .EQV. .true.) .OR. &
348  (isnan(diam) .EQV. .true.) .OR. &
349  (isnan(temp) .EQV. .true.) ) THEN
350  nlocs = nlocs + 1
351 
352  IF ( nlocs == 1 ) THEN
353  WRITE(stdout,'(A,1X,A,1X,I9)') solver_name, &
354  'Invalid variables detected!'
355  WRITE(stdout,'(A,3X,A)') solver_name,'Module: Lagrangian Particle (PLAG).'
356  WRITE(stdout,'(A,3X,A,1X,1PE12.5)') solver_name,'Current time:', &
357  global%currentTime
358 
359  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
360  pregion%iRegionGlobal
361  WRITE(stdout,'(A,6X,A,11(1X,A))') solver_name,'#', &
362  ' iPcl ', &
363  ' idIni ', &
364  ' RegIni ', &
365  ' icg ', &
366  ' Mass ', &
367  ' x-location ', &
368  ' y-location ', &
369  ' z-Location ', &
370  ' Energy ', &
371  ' Diameter '
372  END IF ! nLocs
373 
374  IF ( nlocs <= max_invalid_locs ) THEN
375  WRITE(stdout,'(A,4X,4(1X,I8),6(1X,E13.6))') solver_name,ipcl, &
376  idini,regini,icg, &
377  mass,xpos,ypos,zpos, &
378  ener,diam
379  loc(nlocs,min_val:max_val) = ipcl
380  END IF ! nLocs
381  END IF ! cv
382  END DO ! iPcl
383 
384 ! ******************************************************************************
385 ! Write out message and call error handling routine
386 ! ******************************************************************************
387 
388  IF ( nlocs > 0 ) THEN
389  IF ( nlocs > max_invalid_locs ) THEN
390  WRITE(stdout,'(A,3X,A,1X,I3,1X,A,1X,I9,1X,A)') solver_name, &
391  'Only wrote the first',max_invalid_locs,'of',nlocs, &
392  'particles with invalid variables.'
393  END IF ! nLocs
394 
395  CALL errorstop(global,err_invalid_value,__line__)
396  END IF ! nLocs
397 
398 ! ******************************************************************************
399 ! End
400 ! ******************************************************************************
401 
402  CALL deregisterfunction( global )
403 
404  END SUBROUTINE plag_checkvalidity
405 
406 
407 
408 
409 
410 
411 
412 
413 ! ******************************************************************************
414 ! End
415 ! ******************************************************************************
416 
417 END MODULE plag_modcheckvars
418 
419 ! ******************************************************************************
420 !
421 ! RCS Revision history:
422 !
423 ! $Log: PLAG_ModCheckVars.F90,v $
424 ! Revision 1.7 2008/12/06 08:44:34 mtcampbe
425 ! Updated license.
426 !
427 ! Revision 1.6 2008/11/19 22:17:46 mtcampbe
428 ! Added Illinois Open Source License/Copyright
429 !
430 ! Revision 1.5 2006/04/07 15:19:23 haselbac
431 ! Removed tabs
432 !
433 ! Revision 1.4 2005/12/19 16:49:28 fnajjar
434 ! Added if statement to check validity for kept particles else cycle
435 !
436 ! Revision 1.3 2005/12/07 20:05:25 fnajjar
437 ! Removed check on diam and temp as vals not updated yet when using injection bc
438 !
439 ! Revision 1.2 2005/12/05 19:28:38 fnajjar
440 ! Bug fix for PLAG pointers in RFLO
441 !
442 ! Revision 1.1 2005/12/01 21:53:48 fnajjar
443 ! Initial version
444 !
445 ! ******************************************************************************
446 
447 
448 
449 
450 
451 
452 
453 
cimg_library::CImg::sum
Tfloat sum() const
Return the sum of all the pixel values in an image.
Definition: CImg.h:13022
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
modpartlag::t_plag
Definition: ModPartLag.F90:124
plag_modcheckvars::plag_checkpositivity
subroutine, public plag_checkpositivity(pRegion)
Definition: PLAG_ModCheckVars.F90:93
modtools::isnan
logical function isnan(x)
Definition: ModTools.F90:201
plag_modcheckvars::plag_checkvalidity
subroutine, public plag_checkvalidity(pRegion)
Definition: PLAG_ModCheckVars.F90:255
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
plag_modcheckvars
Definition: PLAG_ModCheckVars.F90:39
plag_modparameters
Definition: PLAG_ModParameters.F90:44