Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_USER_GetDeformation.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: Specify deformation of patches so that moving-grid calculations
26 ! can be carried out outside of GENX.
27 !
28 ! Description: None.
29 !
30 ! Input:
31 ! region Region data
32 !
33 ! Output: None.
34 !
35 ! Notes:
36 ! 1. This routine will have to be hard-coded for each case.
37 ! 2. Only specify deformation for interior vertices.
38 !
39 ! ******************************************************************************
40 !
41 ! $Id: RFLU_USER_GetDeformation.F90,v 1.18 2008/12/06 08:44:30 mtcampbe Exp $
42 !
43 ! Copyright: (c) 2002-2005 by the University of Illinois
44 !
45 ! ******************************************************************************
46 
47 SUBROUTINE rflu_user_getdeformation(region)
48 
49  USE moddatatypes
50  USE moddatastruct, ONLY: t_region
51  USE modbndpatch, ONLY: t_patch
52  USE modglobal, ONLY: t_global
53  USE moderror
54  USE modmpi
55  USE modparameters
56 
57  IMPLICIT NONE
58 
59 ! *****************************************************************************
60 ! Declarations and definitions
61 ! *****************************************************************************
62 
63 ! =============================================================================
64 ! Arguments
65 ! =============================================================================
66 
67  TYPE(t_region) :: region
68 
69 ! =============================================================================
70 ! Locals
71 ! =============================================================================
72 
73  CHARACTER(CHRLEN) :: rcsidentstring
74  INTEGER :: ibv,ipatch,ivg,speedsign
75  REAL(RFREAL) :: nx,ny,nz,ps,ps1,ps2,x,x1,x2,y,z
76  TYPE(t_global), POINTER :: global
77  TYPE(t_patch), POINTER :: ppatch
78 
79 ! *****************************************************************************
80 ! Start
81 ! *****************************************************************************
82 
83  rcsidentstring = '$RCSfile: RFLU_USER_GetDeformation.F90,v $ $Revision: 1.18 $'
84 
85  global => region%global
86 
87  CALL registerfunction(global,'RFLU_USER_GetDeformation',&
88  'RFLU_USER_GetDeformation.F90')
89 
90  IF ( global%myProcid == masterproc .AND. &
91  global%verbLevel > verbose_low ) THEN
92  WRITE(stdout,'(A,1X,A,1X,I3)') solver_name,'Getting deformation...'
93  END IF ! global%myProcid
94 
95 ! *****************************************************************************
96 ! Select case-dependent boundary patch deformation
97 ! *****************************************************************************
98 
99  SELECT CASE ( trim(global%casename) )
100 
101 ! =============================================================================
102 ! Simple box
103 ! =============================================================================
104 
105  CASE ( "box_hex2" )
106  DO ipatch=1,region%grid%nPatches
107  ppatch => region%patches(ipatch)
108 
109  IF ( ppatch%iPatchGlobal == 6 ) THEN
110  DO ibv = 1,ppatch%nBVert
111  ppatch%dXyz(xcoord,ibv) = 8.0_rfreal*global%dtMin
112  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
113  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal*global%dtMin
114  END DO ! ibv
115  ELSE
116  DO ibv = 1,ppatch%nBVert
117  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
118  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
119  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
120  END DO ! ibv
121  END IF ! iPatch
122  END DO ! iPatch
123 
124 ! =============================================================================
125 ! Burning crack problem
126 ! =============================================================================
127 
128  CASE ( "burncrack" )
129  DO ipatch=1,region%grid%nPatches
130  ppatch => region%patches(ipatch)
131 
132  IF ( ppatch%iPatchGlobal == 1 ) THEN
133  DO ibv = 1,ppatch%nBVert
134  nx = ppatch%bvn(xcoord,ibv)
135  ny = ppatch%bvn(ycoord,ibv)
136  nz = ppatch%bvn(zcoord,ibv)
137 
138  ivg = ppatch%bv(ibv)
139 
140  x = region%grid%xyz(xcoord,ivg)
141  y = region%grid%xyz(ycoord,ivg)
142  z = region%grid%xyz(zcoord,ivg)
143 
144  x1 = 0.04_rfreal
145  x2 = 0.07_rfreal
146  ps1 = 10.00_rfreal
147  ps2 = 5.00_rfreal
148 
149  ps = (ps2 - ps1)/(x2 - x1)*x - (x1*ps2 - x2*ps1)/(x2 - x1)
150 
151  ppatch%dXyz(xcoord,ibv) = ps*global%dtMin*nx
152  ppatch%dXyz(ycoord,ibv) = ps*global%dtMin*ny
153  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
154  END DO ! ibv
155  ELSE IF ( ppatch%iPatchGlobal == 4 ) THEN
156  DO ibv = 1,ppatch%nBVert
157  nx = ppatch%bvn(xcoord,ibv)
158  ny = ppatch%bvn(ycoord,ibv)
159  nz = ppatch%bvn(zcoord,ibv)
160 
161  ppatch%dXyz(xcoord,ibv) = 5.0_rfreal*global%dtMin
162  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
163  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
164  END DO ! ibv
165  ELSE
166  DO ibv = 1,ppatch%nBVert
167  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
168  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
169  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
170  END DO ! ibv
171  END IF ! iPatch
172  END DO ! iPatch
173 
174 ! =============================================================================
175 ! Deforming cube (check whether volume is conserved)
176 ! =============================================================================
177 
178  CASE ( "cube_def" )
179  DO ipatch=1,region%grid%nPatches
180  ppatch => region%patches(ipatch)
181 
182  IF ( ppatch%iPatchGlobal == 2 .OR. &
183  ppatch%iPatchGlobal == 5 .OR. &
184  ppatch%iPatchGlobal == 6 ) THEN
185  DO ibv = 1,ppatch%nBVert
186  ivg = ppatch%bv(ibv)
187 
188  z = region%grid%xyz(zcoord,ivg)
189 
190  ps = 100.0_rfreal*z/0.1_rfreal
191 
192  ppatch%dXyz(xcoord,ibv) = ps*global%dtMin
193  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
194  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
195  END DO ! ibv
196  ELSE
197  DO ibv = 1,ppatch%nBVert
198  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
199  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
200  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
201  END DO ! ibv
202  END IF ! iPatch
203  END DO ! iPatch
204 
205 ! =============================================================================
206 ! Cube with tetrahedra only - NOTE different patch numbering...
207 ! =============================================================================
208 
209  CASE ( "cube2pt","cube3pt","cube11pt","cube21pt" )
210  DO ipatch=1,region%grid%nPatches
211  ppatch => region%patches(ipatch)
212 
213  IF ( ppatch%iPatchGlobal == 5 ) THEN
214  DO ibv = 1,ppatch%nBVert
215  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
216  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
217  ppatch%dXyz(zcoord,ibv) = 8.0_rfreal*global%dtMin
218  END DO ! ibv
219  ELSE
220  DO ibv = 1,ppatch%nBVert
221  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
222  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
223  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
224  END DO ! ibv
225  END IF ! iPatch
226  END DO ! iPatch
227 
228  CASE ( "cube6pt" )
229  DO ipatch=1,region%grid%nPatches
230  ppatch => region%patches(ipatch)
231 
232  IF ( ppatch%iPatchGlobal == 4 ) THEN
233  DO ibv = 1,ppatch%nBVert
234  ppatch%dXyz(xcoord,ibv) = -100.0_rfreal*global%dtMin
235  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
236  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
237  END DO ! ibv
238  ELSE
239  DO ibv = 1,ppatch%nBVert
240  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
241  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
242  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
243  END DO ! ibv
244  END IF ! iPatch
245  END DO ! iPatch
246 
247 ! =============================================================================
248 ! Endburner problem
249 ! =============================================================================
250 
251  CASE ( "endburner3pt","endburner5pt","endburner9pt" )
252  DO ipatch=1,region%grid%nPatches
253  ppatch => region%patches(ipatch)
254 
255  IF ( ppatch%iPatchGlobal == 5 ) THEN
256  DO ibv = 1,ppatch%nBVert
257  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
258  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
259  ppatch%dXyz(zcoord,ibv) = 8.0_rfreal*global%dtMin
260  END DO ! ibv
261  ELSE
262  DO ibv = 1,ppatch%nBVert
263  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
264  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
265  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
266  END DO ! ibv
267  END IF ! iPatch
268  END DO ! iPatch
269 
270 ! =============================================================================
271 ! Endburner problem (new)
272 ! =============================================================================
273 
274  CASE ( "endburner3ptnew","endburner5ptnew","endburner9ptnew" )
275  DO ipatch=1,region%grid%nPatches
276  ppatch => region%patches(ipatch)
277 
278  IF ( ppatch%iPatchGlobal == 6 ) THEN
279  DO ibv = 1,ppatch%nBVert
280  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
281  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
282  ppatch%dXyz(zcoord,ibv) = 8.0_rfreal*global%dtMin
283  END DO ! ibv
284  ELSE
285  DO ibv = 1,ppatch%nBVert
286  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
287  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
288  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
289  END DO ! ibv
290  END IF ! iPatch
291  END DO ! iPatch
292 
293 ! =============================================================================
294 ! Endburner problem (angled)
295 ! =============================================================================
296 
297  CASE ( "endburner3pt_angled" )
298  DO ipatch=1,region%grid%nPatches
299  ppatch => region%patches(ipatch)
300 
301  IF ( ppatch%iPatchGlobal == 5 ) THEN
302  DO ibv = 1,ppatch%nBVert
303  nx = ppatch%bvn(xcoord,ibv)
304  ny = ppatch%bvn(ycoord,ibv)
305  nz = ppatch%bvn(zcoord,ibv)
306 
307  ppatch%dXyz(xcoord,ibv) = 8.0_rfreal*global%dtMin*nx
308  ppatch%dXyz(ycoord,ibv) = 8.0_rfreal*global%dtMin*ny
309  ppatch%dXyz(zcoord,ibv) = 8.0_rfreal*global%dtMin*nz
310  END DO ! ibv
311  ELSE
312  DO ibv = 1,ppatch%nBVert
313  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
314  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
315  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
316  END DO ! ibv
317  END IF ! iPatch
318  END DO ! iPatch
319 
320 ! =============================================================================
321 ! Piston problem
322 ! =============================================================================
323 
324  CASE ( "piston_exp","piston_comp" )
325  IF ( trim(global%casename) == "piston_exp" ) THEN
326  speedsign = -1
327  ELSE
328  speedsign = 1
329  END IF ! TRIM(global%casename)
330 
331  DO ipatch=1,region%grid%nPatches
332  ppatch => region%patches(ipatch)
333 
334  IF ( ppatch%iPatchGlobal == 3 ) THEN
335  DO ibv = 1,ppatch%nBVert
336  ppatch%dXyz(xcoord,ibv) = 10.0_rfreal*global%dtMin*speedsign
337  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
338  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
339  END DO ! ibv
340  ELSE
341  DO ibv = 1,ppatch%nBVert
342  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
343  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
344  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
345  END DO ! ibv
346  END IF ! iPatch
347  END DO ! iPatch
348 
349 ! =============================================================================
350 ! Scalability problem
351 ! =============================================================================
352 
353  CASE ( "scalability" )
354  DO ipatch=1,region%grid%nPatches
355  ppatch => region%patches(ipatch)
356 
357  IF ( ppatch%iPatchGlobal == 1 ) THEN
358  DO ibv = 1,ppatch%nBVert
359  nx = ppatch%bvn(xcoord,ibv)
360  ny = ppatch%bvn(ycoord,ibv)
361  nz = ppatch%bvn(zcoord,ibv)
362 
363  ppatch%dXyz(xcoord,ibv) = 1.0_rfreal*global%dtMin*nx
364  ppatch%dXyz(ycoord,ibv) = 1.0_rfreal*global%dtMin*ny
365  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
366  END DO ! ibv
367  ELSE
368  DO ibv = 1,ppatch%nBVert
369  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
370  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
371  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
372  END DO ! ibv
373  END IF ! iPatch
374  END DO ! iPatch
375 
376 ! =============================================================================
377 ! Stargrain slice
378 ! =============================================================================
379 
380  CASE ( "starslice" )
381  DO ipatch=1,region%grid%nPatches
382  ppatch => region%patches(ipatch)
383 
384  IF ( ppatch%iPatchGlobal == 1 ) THEN
385  DO ibv = 1,ppatch%nBVert
386  nx = ppatch%bvn(xcoord,ibv)
387  ny = ppatch%bvn(ycoord,ibv)
388  nz = ppatch%bvn(zcoord,ibv)
389 
390  ppatch%dXyz(xcoord,ibv) = 10.0_rfreal*global%dtMin*nx
391  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
392  ppatch%dXyz(zcoord,ibv) = 10.0_rfreal*global%dtMin*nz
393  END DO ! ibv
394  END IF ! iPatch
395  END DO ! iPatch
396 
397 ! =============================================================================
398 ! Default
399 ! =============================================================================
400 
401  CASE default
402  global%warnCounter = global%warnCounter + 1
403 
404  IF ( global%myProcid == masterproc .AND. &
405  global%verbLevel > verbose_low ) THEN
406  WRITE(stdout,'(A,3(1X,A))') solver_name,'*** WARNING ***', &
407  'No displacements specified.', &
408  'Setting displacements to zero.'
409  END IF ! global
410 
411  DO ipatch=1,region%grid%nPatches
412  ppatch => region%patches(ipatch)
413 
414  DO ibv = 1,ppatch%nBVert
415  ppatch%dXyz(xcoord,ibv) = 0.0_rfreal
416  ppatch%dXyz(ycoord,ibv) = 0.0_rfreal
417  ppatch%dXyz(zcoord,ibv) = 0.0_rfreal
418  END DO ! ibv
419  END DO ! iPatch
420 
421  END SELECT ! global%casename
422 
423 ! *****************************************************************************
424 ! Print diagnostic information on boundary patch movement
425 ! *****************************************************************************
426 
427  IF ( global%myProcid == masterproc .AND. &
428  global%verbLevel > verbose_low .AND. &
429  region%grid%nPatches > 0 ) THEN
430  WRITE(stdout,'(A,3X,A)') solver_name,'Deformation extrema:'
431  WRITE(stdout,'(A,5X,A)') solver_name,'Written only for patches '// &
432  'with non-zero actual vertices.'
433 
434  DO ipatch=1,region%grid%nPatches
435  ppatch => region%patches(ipatch)
436 
437  IF ( ppatch%nBVert > 0 ) THEN
438  WRITE(stdout,'(A,5X,A,1X,I3)') solver_name,'Patch:',ipatch
439 
440  WRITE(stdout,'(A,7X,A,2(1X,E15.8))') solver_name,'dXyz.x:', &
441  minval(ppatch%dXyz(xcoord,1:ppatch%nBVert)), &
442  maxval(ppatch%dXyz(xcoord,1:ppatch%nBVert))
443  WRITE(stdout,'(A,7X,A,2(1X,E15.8))') solver_name,'dXyz.y:', &
444  minval(ppatch%dXyz(ycoord,1:ppatch%nBVert)), &
445  maxval(ppatch%dXyz(ycoord,1:ppatch%nBVert))
446  WRITE(stdout,'(A,7X,A,2(1X,E15.8))') solver_name,'dXyz.z:', &
447  minval(ppatch%dXyz(zcoord,1:ppatch%nBVert)), &
448  maxval(ppatch%dXyz(zcoord,1:ppatch%nBVert))
449  END IF ! pPatch%nBVert
450  END DO ! iPatch
451  END IF ! global%myProcid
452 
453 ! *****************************************************************************
454 ! End
455 ! *****************************************************************************
456 
457  IF ( global%myProcid == masterproc .AND. &
458  global%verbLevel > verbose_low ) THEN
459  WRITE(stdout,'(A,1X,A,1X,I3)') solver_name,'Getting deformation done.'
460  END IF ! global%myProcid
461 
462  CALL deregisterfunction(global)
463 
464 
465 END SUBROUTINE rflu_user_getdeformation
466 
467 ! ******************************************************************************
468 !
469 ! RCS Revision history:
470 !
471 ! $Log: RFLU_USER_GetDeformation.F90,v $
472 ! Revision 1.18 2008/12/06 08:44:30 mtcampbe
473 ! Updated license.
474 !
475 ! Revision 1.17 2008/11/19 22:17:43 mtcampbe
476 ! Added Illinois Open Source License/Copyright
477 !
478 ! Revision 1.16 2005/05/26 22:06:19 haselbac
479 ! Cosmetics only
480 !
481 ! Revision 1.15 2004/03/15 21:04:51 haselbac
482 ! Added deformations for piston problem
483 !
484 ! Revision 1.14 2003/08/20 02:09:58 haselbac
485 ! Changed verbosity conditions to reduce solver output in GENx runs
486 !
487 ! Revision 1.13 2003/07/22 02:07:36 haselbac
488 ! Added global%warnCounter
489 !
490 ! Revision 1.12 2003/04/12 16:39:42 haselbac
491 ! Added burning crack, reordered cases
492 !
493 ! Revision 1.11 2003/03/31 16:18:47 haselbac
494 ! Added CASE for endburner3pt_angled
495 !
496 ! Revision 1.10 2003/03/25 19:17:48 haselbac
497 ! Added deformation specification for case box_hex2
498 !
499 ! Revision 1.9 2003/03/18 21:35:10 haselbac
500 ! Added new endburner deformation, got lost in last merge...
501 !
502 ! Revision 1.8 2003/03/15 19:03:40 haselbac
503 ! Use iPatchGlobal, changes for || runs
504 !
505 ! Revision 1.7 2003/02/20 19:48:50 haselbac
506 ! Rewrote with different loop-select order, added starslice and default
507 !
508 ! Revision 1.6 2003/02/01 00:26:35 haselbac
509 ! Added deformation for new endburner geometry
510 !
511 ! Revision 1.5 2003/01/28 14:53:43 haselbac
512 ! Clean-up and added cube_def case
513 !
514 ! Revision 1.4 2003/01/03 22:06:24 haselbac
515 ! Added CASE for 6pt cube - different patch numbering
516 !
517 ! Revision 1.3 2002/11/15 14:09:56 haselbac
518 ! Added endburner patch deformation
519 !
520 ! Revision 1.2 2002/11/08 21:36:56 haselbac
521 ! Made deformation case-specific
522 !
523 ! Revision 1.1 2002/10/27 19:20:28 haselbac
524 ! Initial revision
525 !
526 ! ******************************************************************************
527 
528 
529 
530 
531 
532 
533 
y
void int int REAL REAL * y
Definition: read.cpp:74
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
z
void int int int REAL REAL REAL * z
Definition: write.cpp:76
x
void int int REAL * x
Definition: read.cpp:74
rflu_user_getdeformation
subroutine rflu_user_getdeformation(region)
Definition: RFLU_USER_GetDeformation.F90:47
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
modbndpatch::t_patch
Definition: ModBndPatch.F90:91