Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModRocstarTools.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: Collection of routines related to GENX interaction.
26 !
27 ! Description: None
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModRocstarTools.F90,v 1.29 2008/12/06 08:44:21 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2004-2005 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modrocstartools
40 
41  USE moddatatypes
42  USE modparameters
43  USE moderror
44  USE modglobal, ONLY: t_global
45  USE modbndpatch, ONLY: t_patch
46  USE moddatastruct, ONLY: t_region
47  USE modgrid, ONLY: t_grid
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52  include 'roccomf90.h'
53 
54  PRIVATE
55  PUBLIC :: rflu_genx_constraindisp, &
56  rflu_genx_initbflag, &
57  rflu_genx_movegrid
58 
59 ! ******************************************************************************
60 ! Declarations and definitions
61 ! ******************************************************************************
62 
63 ! ==============================================================================
64 ! Private
65 ! ==============================================================================
66 
67  CHARACTER(CHRLEN) :: &
68  RCSIdentString = '$RCSfile: RFLU_ModRocstarTools.F90,v $ $Revision: 1.29 $'
69 
70 ! ==============================================================================
71 ! Public
72 ! ==============================================================================
73 
74 
75 ! ******************************************************************************
76 ! Contained routines
77 ! ******************************************************************************
78 
79  CONTAINS
80 
81 
82 
83 
84 
85 
86 
87 
88 
89 ! ******************************************************************************
90 !
91 ! Purpose: Constrain displacements to allow burn-out simulations to case.
92 !
93 ! Description:
94 !
95 ! Input:
96 ! pRegion Pointer to region data
97 !
98 ! Output: None.
99 !
100 ! Notes: Surface Types: Cylindrical, Ellipsoidical (Spheroid), and Spherical
101 !
102 ! Ranges: Each surface type is applied only for a particular range of
103 ! the longitudinal (long axis) coordinate. The code is currently
104 ! configured for the RSRM where the head end is ellipsoidical,
105 ! the main segments are cylindrical, and the aft is spherical.
106 ! The code will check if a given node is in the headend, or
107 ! the aft end. If neither, it assumes cylindrical constraints.
108 !
109 ! Config: To configure the constraints, one must specify the ranges for
110 ! which to apply each constraint type. The relevant params are:
111 !
112 ! Constraint Surface Parameters
113 ! ------------------ ----------------
114 ! Cylindrical caseRadius
115 ! Spherical sphereCenter,caseRadius
116 ! Ellipsoidical caseTip,ellipsLong,ellipsTrans
117 !
118 ! caseRadius = cylindrical radius of the rocket case
119 ! sphereCenter = longitudinal coordinate of the sphere center
120 ! caseTip = the minimum longitudinal coordinate value
121 ! (corresponds to the top [headend] of the case)
122 ! ellipsLong = longitudinal ellipse semi axis (a)
123 ! ellipsTrans = transverse ellipse semi axis (b and c)
124 !
125 ! From this, the head end of the rocket is assumed to have
126 ! longitudinal coordinates less than (caseTip + ellipsLong) and
127 ! the aft end has longitudinal coordinates greater than the
128 ! sphereCenter parameter.
129 !
130 ! Method: The length of the vector R from the constraint surface origin
131 ! to the node is calculated. If the node lies inside the
132 ! surface, do nothing - the node is unconstrained.
133 ! If the node lies outside the surface, then R is scaled such
134 ! that the new node position is *on* the constraint surface.
135 !
136 ! After all nodes have been checked/constrained, we loop over
137 ! each surface element and turn off burning for those which have
138 ! all of their vertices on the constraint surface. These faces
139 ! have "burned out".
140 !
141 !
142 ! Changes: Added a hole for the igniter (ignHole) in the RSRM headend
143 ! ******************************************************************************
144 
145 SUBROUTINE rflu_genx_constraindisp(pRegion)
146 
147  USE modtools
148 
149  IMPLICIT NONE
150 
151 ! ******************************************************************************
152 ! Declarations and definitions
153 ! ******************************************************************************
154 
155 ! ==============================================================================
156 ! Arguments
157 ! ==============================================================================
158 
159  TYPE(t_region), POINTER :: pregion
160 
161 ! ==============================================================================
162 ! Locals
163 ! ==============================================================================
164 
165  INTEGER :: cntr,errorflag,ifl,ipatch,ivg,ivl
166  INTEGER :: coordtrans1,coordtrans2,coordlong,ldir
167  INTEGER :: bocount, botot, cvcount, cvtot,info
168  REAL(RFREAL) :: caseradius,caseradius2,radius2,theta,x,y,z
169  REAL(RFREAL) :: ellipsc,ellipslong,ellipstrans,ellipslong2,ellipstrans2
170  REAL(RFREAL) :: casetip, spherecenter, longc, ignhole
171  REAL(RFREAL) :: backx, backy, tolerance, dispmag
172  REAL(RFREAL) :: lminplane, lmaxplane, t1minplane
173  REAL(RFREAL) :: t1maxplane, t2minplane, t2maxplane
174  REAL(RFREAL), DIMENSION(:,:), POINTER :: pxyz,pxyzold
175  TYPE(t_global), POINTER :: global
176  TYPE(t_grid), POINTER :: pgrid,pgridold
177  TYPE(t_patch), POINTER :: ppatch
178 
179 ! ******************************************************************************
180 ! Start
181 ! ******************************************************************************
182 
183  global => pregion%global
184 
185  CALL registerfunction(global,'RFLU_GENX_ConstrainDisp',&
186  'RFLU_ModRocstarTools.F90')
187 
188  IF ( global%myProcid == masterproc .AND. &
189  global%verbLevel >= verbose_high ) THEN
190  WRITE(stdout,'(A,1X,A)') solver_name,'Constraining displacements...'
191  END IF ! global%myProcid
192 
193  pgrid => pregion%grid
194  pxyz => pgrid%xyz
195 
196 ! ==============================================================================
197 ! Rocket orientation specification
198 ! StarAft and RSRM are along the X axis and StarSlice is along Z
199 ! ==============================================================================
200 
201  coordtrans1 = global%cnstrCoordT1 ! transverse-1
202  coordtrans2 = global%cnstrCoordT2 ! transverse-2
203  coordlong = global%cnstrCoordL ! longitudinal (long axis)
204 ! WRITE(*,*) 'coordLong = ', coordLong
205  ldir = nint(sign(1.0_rfreal,global%cnstrAftEnd - global%cnstrHeadEnd))
206 
207 
208 ! ==============================================================================
209 ! Case radius setting is common to all constraint surfaces
210 ! ==============================================================================
211 
212  caseradius = global%cnstrCaseRad
213  caseradius2 = caseradius*caseradius
214 
215 ! ==============================================================================
216 ! Ellipsoidal constraints (applied for [coord_long < ellipsC])
217 ! ==============================================================================
218 
219  ellipslong = global%cnstrEllipsL
220  ellipstrans = global%cnstrEllipsT
221  ellipslong2 = 1.0_rfreal/(ellipslong * ellipslong)
222  ellipstrans2 = 1.0_rfreal/(ellipstrans * ellipstrans)
223  ellipsc = global%cnstrHeadEnd
224 
225 
226 ! ==============================================================================
227 ! Spherical constraints (applied for [coord_long > sphereC])
228 ! Sphere radius assumed to be equal to caseRadius
229 ! ==============================================================================
230 
231  backx = global%cnstrAftEnd ! End of nozzle bucket at t = 0
232  backy = global%cnstrNozY ! End of nozzle bucket at t = 0, (z = 0)
233  tolerance = global%cnstrTol2 ! Wiggle room
234  spherecenter = backx - ldir*sqrt(caseradius2 - backy**2)
235 
236 ! ==============================================================================
237 ! Planar constraints
238 ! ==============================================================================
239  lminplane = global%cnstrLMinPlane
240  lmaxplane = global%cnstrLMaxPlane
241  t1minplane = global%cnstrT1MinPlane
242  t1maxplane = global%cnstrT1MaxPlane
243  t2minplane = global%cnstrT2MinPlane
244  t2maxplane = global%cnstrT2MaxPlane
245 
246 ! ==============================================================================
247 ! Keep track of how many nodes are constrained and how many faces burn out
248 ! ==============================================================================
249  bocount = 0
250  cvcount = 0
251 
252 ! *****************************************************************************=
253 ! Loop over patches
254 ! *****************************************************************************=
255 
256  DO ipatch = 1,pgrid%nPatches
257  ppatch => pregion%patches(ipatch)
258 
259 ! -----------------------------------------------------------------------------
260 ! Loop over vertices, check and if necessary limit new position
261 ! -----------------------------------------------------------------------------
262 
263 
264  DO ivl = 1,ppatch%nBVert
265  ivg = ppatch%bv(ivl)
266 
267  x = pxyz(coordlong,ivg) + ppatch%dXyz(coordlong,ivl)
268  y = pxyz(coordtrans1,ivg) + ppatch%dXyz(coordtrans1,ivl)
269  z = pxyz(coordtrans2,ivg) + ppatch%dXyz(coordtrans2,ivl)
270 
271 ! -----------------------------------------------------------------------------
272 ! Spherical constraints (aft end)
273 ! -----------------------------------------------------------------------------
274 
275  IF( ( ppatch%bcCoupled == bc_burning ) .AND. &
276  ( (ldir > 0 .AND. x > spherecenter ) .OR. &
277  (ldir < 0 .AND. x < spherecenter ) ) ) THEN
278  info = 1
279  longc = spherecenter
280  x = x - longc
281  radius2 = x*x + y*y + z*z
282 
283 
284 ! -----------------------------------------------------------------------------
285 ! Ellipsoidal constraints (head end)
286 ! -----------------------------------------------------------------------------
287 
288  ELSE IF( ( ldir > 0 .AND. x < ellipsc) .OR. &
289  ( ldir < 0 .AND. x > ellipsc) ) THEN
290  info = 2
291  longc = ellipsc
292  x = x - longc
293  radius2 =(x*x*ellipslong2+y*y*ellipstrans2+z*z*ellipstrans2)*&
294  caseradius2
295 
296 
297 ! ------------------------------------------------------------------------------
298 ! Cylindrical constraints (everywhere else)
299 ! ------------------------------------------------------------------------------
300 
301  ELSE
302  info = 3
303  longc = x
304  x = x - longc
305  radius2 = y*y+z*z
306  ENDIF ! x
307 
308 
309 ! ------------------------------------------------------------------------------
310 ! Constraint section common to all surfaces
311 ! -----------------------------------------------------------------------------
312  IF(radius2 > caseradius2) THEN
313 
314 !RAF Do not constrain nodes that have zero displacements. Hope this
315 !RAF allows normal operation while preventing negative volume in BSM,
316 !RAF in which nozzle protrudes beyond case radius.
317 
318  dispmag = sqrt(ppatch%dXyz(coordlong,ivl)**2 + &
319  ppatch%dXyz(coordtrans1,ivl)**2 + &
320  ppatch%dXyz(coordtrans2,ivl)**2 )
321  IF(dispmag > 1.0e-12) THEN
322 
323  cvcount = cvcount + 1
324  theta = sqrt(caseradius2/radius2)
325 ! if(info == 1) then
326 ! WRITE(*,*) 'Aft end constraints:',x,y,z,theta
327 ! endif
328 ! if(info == 2) then
329 ! WRITE(*,*) 'Head end constraints:',x,y,z,theta
330 ! endif
331 ! if(info == 3) then
332 ! WRITE(*,*) 'Bore constraints:',x,y,z,theta
333 ! endif
334 
335  x = theta*x
336  y = theta*y
337  z = theta*z
338 
339  ENDIF ! dispmag
340 
341  x = x + longc
342  ppatch%dXyz(coordlong,ivl) = x - pxyz(coordlong,ivg)
343  ppatch%dXyz(coordtrans1,ivl) = y - pxyz(coordtrans1,ivg)
344  ppatch%dXyz(coordtrans2,ivl) = z - pxyz(coordtrans2,ivg)
345 
346  ELSE ! If it is not constrained in other ways, check planar constraints
347 !RAF x = x + longC
348 !RAF For some reason the compiler gets a NaN for longC with the above line.
349  x = pxyz(coordlong,ivg) + ppatch%dXyz(coordlong,ivl)
350 
351 !RAF Apply planar constraints only to moving nodes
352 
353  dispmag = sqrt(ppatch%dXyz(coordlong,ivl)**2 + &
354  ppatch%dXyz(coordtrans1,ivl)**2 + &
355  ppatch%dXyz(coordtrans2,ivl)**2 )
356  IF(dispmag > 1.0e-12) THEN
357 
358  IF(x < lminplane) x = lminplane
359  IF(x > lmaxplane) x = lmaxplane
360  IF(y < t1minplane) y = t1minplane
361  IF(y > t1maxplane) y = t1maxplane
362  IF(z < t2minplane) z = t2minplane
363  IF(z > t2maxplane) z = t2maxplane
364 ! IF(x < LMinPlane) then
365 ! WRITE(*,*) 'xmin planar constraint:',x,y,z
366 ! WRITE(*,*) 'longC = ',longC
367 ! WRITE(*,*) 'pXyz(coordLong,ivg) = ',pXyz(coordLong,ivg)
368 ! WRITE(*,*) 'pPatch%dXyz(coordLong,ivl) = ',pPatch%dXyz(coordLong,ivl)
369 ! x = LMinPlane
370 ! endif
371 ! IF(x > LMaxPlane) then
372 ! WRITE(*,*) 'xamx planar constraint:',x,y,z
373 ! x = LMaxPlane
374 ! endif
375 ! IF(y < T1MinPlane) then
376 ! WRITE(*,*) 'ymin planar constraint:',x,y,z
377 ! y = T1MinPlane
378 ! endif
379 ! IF(y > T1MaxPlane) then
380 ! WRITE(*,*) 'ymax planar constraint:',x,y,z
381 ! y = T1MaxPlane
382 ! endif
383 ! IF(z < T2MinPlane) then
384 ! WRITE(*,*) 'zmin planar constraint:',x,y,z
385 ! z = T2MinPlane
386 ! endif
387 ! IF(z > T2MaxPlane) then
388 ! WRITE(*,*) 'zmax planar constraint:',x,y,z
389 ! z = T2MaxPlane
390 ! endif
391 
392  ENDIF ! dispmag
393 
394  ppatch%dXyz(coordlong,ivl) = x - pxyz(coordlong,ivg)
395  ppatch%dXyz(coordtrans1,ivl) = y - pxyz(coordtrans1,ivg)
396  ppatch%dXyz(coordtrans2,ivl) = z - pxyz(coordtrans2,ivg)
397 
398  ENDIF ! radius2
399  END DO ! ivl
400 
401 ! -----------------------------------------------------------------------------
402 ! Loop over burning triangles, turn off burning if all vertices on case
403 ! -----------------------------------------------------------------------------
404 
405  IF ( ppatch%bcCoupled == bc_burning ) THEN
406  DO ifl = 1,ppatch%nBTris
407  cntr = 0
408 
409  DO ivl = 1,3
410  ivg = ppatch%bTri2v(ivl,ifl)
411 
412  x = pxyz(coordlong,ivg) + ppatch%dXyz(coordlong,ivl)
413  y = pxyz(coordtrans1,ivg) + ppatch%dXyz(coordtrans1,ivl)
414  z = pxyz(coordtrans2,ivg) + ppatch%dXyz(coordtrans2,ivl)
415 
416  IF( (ldir > 0 .AND. x > spherecenter) .OR. &
417  (ldir < 0 .AND. x < spherecenter) ) THEN
418  x = x - spherecenter
419  radius2 = x*x + y*y + z*z
420  ELSE IF ( (ldir > 0 .AND. x < ellipsc) .OR. &
421  (ldir < 0 .AND. x > ellipsc) ) THEN
422  x = x - ellipsc
423  radius2 = (x*x*ellipslong2+y*y*ellipstrans2+z*z*ellipstrans2) &
424  * caseradius2
425  ELSE
426  radius2 = y*y + z*z
427  ENDIF ! x
428  IF ( radius2 >= (caseradius2-global%cnstrTol1)) THEN
429  cntr = cntr + 1
430  ELSE
431  x = pxyz(coordlong,ivg) + ppatch%dXyz(coordlong,ivl)
432  IF(x <= lminplane) THEN
433  cntr = cntr + 1
434  ELSE IF(x >= lmaxplane) THEN
435  cntr = cntr + 1
436  ELSE IF(y <= t1minplane) THEN
437  cntr = cntr + 1
438  ELSE IF(y >= t1maxplane) THEN
439  cntr = cntr + 1
440  ELSE IF(z <= t2minplane) THEN
441  cntr = cntr + 1
442  ELSE IF(z >= t2maxplane) THEN
443  cntr = cntr + 1
444  ENDIF
445  END IF ! FloatEqual
446 
447  END DO ! ivl
448 
449  IF ( cntr == 3 ) THEN
450  bocount = bocount + 1
451  ppatch%bflag(ifl) = 0
452  ppatch%mdotAlp(ifl) = 0.0_rfreal
453 ! ELSE
454 ! pPatch%bflag(ifl) = 1 ! make sure burning is on if not burned out
455  END IF ! cntr
456  END DO ! ifl
457 
458 ! -----------------------------------------------------------------------------
459 ! Loop over quadrilaterals, turn off burning if all vertices on case
460 ! -----------------------------------------------------------------------------
461 
462  DO ifl = 1,ppatch%nBQuads
463  cntr = 0
464 
465  DO ivl = 1,4
466  ivg = ppatch%bQuad2v(ivl,ifl)
467 
468  x = pxyz(coordlong,ivg) + ppatch%dXyz(coordlong,ivl)
469  y = pxyz(coordtrans1,ivg) + ppatch%dXyz(coordtrans1,ivl)
470  z = pxyz(coordtrans2,ivg) + ppatch%dXyz(coordtrans2,ivl)
471 
472  IF( (ldir > 0 .AND. x > spherecenter) .OR. &
473  (ldir < 0 .AND. x < spherecenter) ) THEN
474  x = x - spherecenter
475  radius2 = x*x + y*y + z*z
476  ELSE IF ( (ldir > 0 .AND. x < ellipsc) .OR. &
477  (ldir > 0 .AND. x < ellipsc) ) THEN
478  x = x - ellipsc
479  radius2 = (x*x*ellipslong2+y*y*ellipstrans2+z*z*ellipstrans2) &
480  * caseradius2
481  ELSE
482  radius2 = y*y + z*z
483  ENDIF ! x
484  IF ( radius2 >= (caseradius2-global%cnstrTol1)) THEN
485  cntr = cntr + 1
486  ELSE
487  x = pxyz(coordlong,ivg) + ppatch%dXyz(coordlong,ivl)
488  IF(x <= lminplane) THEN
489  cntr = cntr + 1
490  ELSE IF(x >= lmaxplane) THEN
491  cntr = cntr + 1
492  ELSE IF(y <= t1minplane) THEN
493  cntr = cntr + 1
494  ELSE IF(y >= t1maxplane) THEN
495  cntr = cntr + 1
496  ELSE IF(z <= t2minplane) THEN
497  cntr = cntr + 1
498  ELSE IF(z >= t2maxplane) THEN
499  cntr = cntr + 1
500  ENDIF
501  END IF ! FloatEqual
502  END DO ! ivl
503 
504  IF ( cntr == 4 ) THEN ! All vertices on case, stop motion and burning
505  bocount = bocount + 1
506  ppatch%bflag(ifl+ppatch%nBTris) = 0
507  ppatch%mdotAlp(ifl+ppatch%nBTris) = 0.0_rfreal
508 ! ELSE
509 ! pPatch%bflag(ifl) = 1
510  END IF ! cntr
511  END DO ! ifl
512  END IF ! pPatch%bcCoupled
513  END DO ! iPatch
514 
515 ! *****************************************************************************
516 ! End
517 ! *****************************************************************************
518 
519  IF (global%checkLevel == check_high) THEN
520  botot = 0
521  cvtot = 0
522  CALL mpi_reduce(bocount,botot,1,mpi_integer,mpi_sum, &
523  masterproc,global%mpiComm,global%error)
524  IF ( global%error /= err_none ) THEN
525  CALL errorstop(global,err_mpi_trouble,__line__)
526  END IF ! global%errorFlag
527  CALL mpi_reduce(cvcount,cvtot,1,mpi_integer,mpi_sum, &
528  masterproc,global%mpiComm,global%error)
529  IF ( global%error /= err_none ) THEN
530  CALL errorstop(global,err_mpi_trouble,__line__)
531  END IF ! global%errorFlag
532  IF ( global%myProcid == masterproc .AND. &
533  global%verbLevel >= verbose_high) THEN
534  WRITE(stdout,'(A,3X,A,1X,I9)') solver_name, &
535  'Total number of constrained nodes:',cvtot
536  WRITE(stdout,'(A,3X,A,1X,I9)') solver_name, &
537  'Total number of burned out faces:',botot
538  END IF ! global%myProcid
539  ENDIF ! global%checkLevel
540 
541  IF ( global%myProcid == masterproc .AND. &
542  global%verbLevel >= verbose_high ) THEN
543  WRITE(stdout,'(A,1X,A)') solver_name,'Constraining displacements done.'
544  END IF ! global%myProcid
545 
546  CALL deregisterfunction(global)
547 
548 END SUBROUTINE rflu_genx_constraindisp
549 
550 
551 SUBROUTINE rflu_genx_initbflag(pRegion)
552 
553  USE modtools
554 
555  IMPLICIT NONE
556 
557  ! ******************************************************************************
558  ! Declarations and definitions
559  ! ******************************************************************************
560 
561  ! ==============================================================================
562  ! Arguments
563  ! ==============================================================================
564 
565  TYPE(t_region), POINTER :: pregion
566 
567  ! ==============================================================================
568  ! Locals
569  ! ==============================================================================
570 
571  INTEGER :: cntr,errorflag,ifl,ipatch,ivg,ivl
572  INTEGER :: coordtrans1,coordtrans2,coordlong,ldir
573  INTEGER :: bocount, botot, cvcount, cvtot,info
574  REAL(RFREAL) :: caseradius,caseradius2,radius2,theta,x,y,z
575  REAL(RFREAL) :: ellipsc,ellipslong,ellipstrans,ellipslong2,ellipstrans2
576  REAL(RFREAL) :: casetip, spherecenter, longc, ignhole
577  REAL(RFREAL) :: backx, backy, tolerance
578  REAL(RFREAL) :: lminplane, lmaxplane, t1minplane
579  REAL(RFREAL) :: t1maxplane, t2minplane, t2maxplane
580  REAL(RFREAL), DIMENSION(:,:), POINTER :: pxyz,pxyzold
581  TYPE(t_global), POINTER :: global
582  TYPE(t_grid), POINTER :: pgrid,pgridold
583  TYPE(t_patch), POINTER :: ppatch
584 
585  ! ******************************************************************************
586  ! Start
587  ! ******************************************************************************
588 
589  global => pregion%global
590 
591  CALL registerfunction(global,'RFLU_GENX_InitBFLAG',&
592  'RFLU_ModRocstarTools.F90')
593 
594  IF ( global%myProcid == masterproc .AND. &
595  global%verbLevel >= verbose_high ) THEN
596  WRITE(stdout,'(A,1X,A)') solver_name,'Initializing BFLAG...'
597  END IF ! global%myProcid
598 
599  pgrid => pregion%grid
600  pxyz => pgrid%xyz
601 
602  ! ==============================================================================
603  ! Rocket orientation specification
604  ! StarAft and RSRM are along the X axis and StarSlice is along Z
605  ! ==============================================================================
606  IF(global%cnstrCaseRad > 0) THEN
607  coordtrans1 = global%cnstrCoordT1 ! transverse-1
608  coordtrans2 = global%cnstrCoordT2 ! transverse-2
609  coordlong = global%cnstrCoordL ! longitudinal (long axis)
610  ldir = nint(sign(1.0_rfreal,global%cnstrAftEnd - global%cnstrHeadEnd))
611 
612 
613  ! ==============================================================================
614  ! Case radius setting is common to all constraint surfaces
615  ! ==============================================================================
616 
617  caseradius = global%cnstrCaseRad
618  caseradius2 = caseradius*caseradius
619 
620  ! ==============================================================================
621  ! Ellipsoidal constraints (applied for [coord_long < ellipsC])
622  ! ==============================================================================
623 
624  ellipslong = global%cnstrEllipsL
625  ellipstrans = global%cnstrEllipsT
626  ellipslong2 = 1.0_rfreal/(ellipslong * ellipslong)
627  ellipstrans2 = 1.0_rfreal/(ellipstrans * ellipstrans)
628  ellipsc = global%cnstrHeadEnd
629 
630 
631  ! ==============================================================================
632  ! Spherical constraints (applied for [coord_long > sphereC])
633  ! Sphere radius assumed to be equal to caseRadius
634  ! ==============================================================================
635 
636  backx = global%cnstrAftEnd ! End of nozzle bucket at t = 0
637  backy = global%cnstrNozY ! End of nozzle bucket at t = 0, (z = 0)
638  tolerance = global%cnstrTol2 ! Wiggle room
639  spherecenter = backx - ldir*sqrt(caseradius2 - backy**2)
640 
641  ! ==============================================================================
642  ! Planar constraints
643  ! ==============================================================================
644  lminplane = global%cnstrLMinPlane
645  lmaxplane = global%cnstrLMaxPlane
646  t1minplane = global%cnstrT1MinPlane
647  t1maxplane = global%cnstrT1MaxPlane
648  t2minplane = global%cnstrT2MinPlane
649  t2maxplane = global%cnstrT2MaxPlane
650 
651  ! ==============================================================================
652  ! Keep track of how many nodes are constrained and how many faces burn out
653  ! ==============================================================================
654  bocount = 0
655  cvcount = 0
656 
657  ! *****************************************************************************=
658  ! Loop over patches
659  ! *****************************************************************************=
660 
661  DO ipatch = 1,pgrid%nPatches
662  ppatch => pregion%patches(ipatch)
663 
664  ! -----------------------------------------------------------------------------
665  ! Loop over burning triangles, turn off burning if all vertices on case
666  ! -----------------------------------------------------------------------------
667 
668  IF ( ppatch%bcCoupled == bc_burning ) THEN
669  DO ifl = 1,ppatch%nBTris
670  cntr = 0
671 
672  DO ivl = 1,3
673  ivg = ppatch%bTri2v(ivl,ifl)
674 
675  x = pxyz(coordlong,ivg)
676  y = pxyz(coordtrans1,ivg)
677  z = pxyz(coordtrans2,ivg)
678 
679  IF( (ldir > 0 .AND. x > spherecenter) .OR. &
680  (ldir < 0 .AND. x < spherecenter) ) THEN
681  x = x - spherecenter
682  radius2 = x*x + y*y + z*z
683  ELSE IF ( (ldir > 0 .AND. x < ellipsc) .OR. &
684  (ldir < 0 .AND. x > ellipsc) ) THEN
685  x = x - ellipsc
686  radius2 = (x*x*ellipslong2+y*y*ellipstrans2+z*z*ellipstrans2) &
687  * caseradius2
688  ELSE
689  radius2 = y*y + z*z
690  ENDIF ! x
691  IF ( radius2 >= (caseradius2-global%cnstrTol1)) THEN
692  cntr = cntr + 1
693  ELSE
694  x = pxyz(coordlong,ivg)
695  IF(x <= lminplane) THEN
696  cntr = cntr + 1
697  ELSE IF(x >= lmaxplane) THEN
698  cntr = cntr + 1
699  ELSE IF(y <= t1minplane) THEN
700  cntr = cntr + 1
701  ELSE IF(y >= t1maxplane) THEN
702  cntr = cntr + 1
703  ELSE IF(z <= t2minplane) THEN
704  cntr = cntr + 1
705  ELSE IF(z >= t2maxplane) THEN
706  cntr = cntr + 1
707  ENDIF
708  END IF ! FloatEqual
709 
710  END DO ! ivl
711 
712  IF ( cntr == 3 ) THEN
713  bocount = bocount + 1
714  ppatch%bflag(ifl) = 0
715  ppatch%mdotAlp(ifl) = 0.0_rfreal
716  ELSE
717  ppatch%bflag(ifl) = 1 ! make sure burning is on if not burned out
718  END IF ! cntr
719  END DO ! ifl
720 
721  ! -----------------------------------------------------------------------------
722  ! Loop over quadrilaterals, turn off burning if all vertices on case
723  ! -----------------------------------------------------------------------------
724 
725  DO ifl = 1,ppatch%nBQuads
726  cntr = 0
727 
728  DO ivl = 1,4
729  ivg = ppatch%bQuad2v(ivl,ifl)
730 
731  x = pxyz(coordlong,ivg)
732  y = pxyz(coordtrans1,ivg)
733  z = pxyz(coordtrans2,ivg)
734 
735  IF( (ldir > 0 .AND. x > spherecenter) .OR. &
736  (ldir < 0 .AND. x < spherecenter) ) THEN
737  x = x - spherecenter
738  radius2 = x*x + y*y + z*z
739  ELSE IF ( (ldir > 0 .AND. x < ellipsc) .OR. &
740  (ldir < 0 .AND. x < ellipsc) ) THEN
741  x = x - ellipsc
742  radius2 = (x*x*ellipslong2+y*y*ellipstrans2+z*z*ellipstrans2) &
743  * caseradius2
744  ELSE
745  radius2 = y*y + z*z
746  ENDIF ! x
747  IF ( radius2 >= (caseradius2-global%cnstrTol1)) THEN
748  cntr = cntr + 1
749  ELSE
750  x = pxyz(coordlong,ivg)
751  IF(x <= lminplane) THEN
752  cntr = cntr + 1
753  ELSE IF(x >= lmaxplane) THEN
754  cntr = cntr + 1
755  ELSE IF(y <= t1minplane) THEN
756  cntr = cntr + 1
757  ELSE IF(y >= t1maxplane) THEN
758  cntr = cntr + 1
759  ELSE IF(z <= t2minplane) THEN
760  cntr = cntr + 1
761  ELSE IF(z >= t2maxplane) THEN
762  cntr = cntr + 1
763  ENDIF
764  END IF ! FloatEqual
765  END DO ! ivl
766 
767  IF ( cntr == 4 ) THEN ! All vertices on case, stop motion and burning
768  bocount = bocount + 1
769  ppatch%bflag(ifl+ppatch%nBTris) = 0
770  ppatch%mdotAlp(ifl+ppatch%nBTris) = 0.0_rfreal
771  ELSE
772  ppatch%bflag(ifl) = 1
773  END IF ! cntr
774  END DO ! ifl
775  END IF ! pPatch%bcCoupled
776  END DO ! iPatch
777 
778  ! *****************************************************************************
779  ! End
780  ! *****************************************************************************
781 
782  IF (global%checkLevel == check_high) THEN
783  botot = 0
784  CALL mpi_reduce(bocount,botot,1,mpi_integer,mpi_sum, &
785  masterproc,global%mpiComm,global%error)
786  IF ( global%error /= err_none ) THEN
787  CALL errorstop(global,err_mpi_trouble,__line__)
788  END IF ! global%errorFlag
789  IF ( global%myProcid == masterproc .AND. &
790  global%verbLevel >= verbose_high) THEN
791  WRITE(stdout,'(A,3X,A,1X,I9)') solver_name, &
792  'Total number of burned out faces:',botot
793  END IF ! global%myProcid
794  ENDIF ! global%checkLevel
795 
796  ENDIF ! (global%cnstrCaseRad > 0)
797 
798  IF ( global%myProcid == masterproc .AND. &
799  global%verbLevel >= verbose_high ) THEN
800  WRITE(stdout,'(A,1X,A)') solver_name,'Initializing BFLAG done.'
801  END IF ! global%myProcid
802 
803  CALL deregisterfunction(global)
804 
805 END SUBROUTINE rflu_genx_initbflag
806 
807 
808 
809 
810 
811 
812 
813 
814 ! ******************************************************************************
815 !
816 ! Purpose: Move grid through Roccom.
817 !
818 ! Description:
819 !
820 ! Input:
821 ! regions Region data
822 !
823 ! Output: None.
824 !
825 ! Notes: None.
826 !
827 ! ******************************************************************************
828 
829 SUBROUTINE rflu_genx_movegrid(regions)
830 
831  IMPLICIT NONE
832 
833 ! *****************************************************************************
834 ! Declarations and definitions
835 ! *****************************************************************************
836 
837 ! =============================================================================
838 ! Arguments
839 ! =============================================================================
840 
841  TYPE(t_region), DIMENSION(:), POINTER :: regions
842 
843 ! =============================================================================
844 ! Locals
845 ! =============================================================================
846 
847  CHARACTER(CHRLEN) :: winname
848  INTEGER :: errorflag,icg,ipatch,ireg,ivg,ivl
849  INTEGER :: handledisp,handleoption,handlepmesh,handlesmooth
850  REAL(RFREAL) :: disptot,dispmax
851  REAL(RFREAL), DIMENSION(:,:), POINTER :: pdisp,prhs,pxyz,pxyzold
852  TYPE(t_global), POINTER :: global
853  TYPE(t_grid), POINTER :: pgrid,pgridold
854  TYPE(t_patch), POINTER :: ppatch
855  TYPE(t_region), POINTER :: pregion
856 
857 ! *****************************************************************************
858 ! Start
859 ! *****************************************************************************
860 
861  global => regions(1)%global
862 
863  CALL registerfunction(global,'RFLU_GENX_MoveGrid',&
864  'RFLU_ModRocstarTools.F90')
865 
866  IF ( global%myProcid == masterproc .AND. &
867  global%verbLevel >= verbose_high ) THEN
868  WRITE(stdout,'(A,1X,A)') solver_name,'Moving grid...'
869  END IF ! global%myProcid
870 
871 ! *****************************************************************************
872 ! Get function and attribute handles
873 ! *****************************************************************************
874 
875  winname = trim(global%volWinName)
876 
877  handlesmooth = com_get_function_handle('Rocflu-MOP.smooth')
878  handlepmesh = com_get_attribute_handle(trim(winname)//'.pmesh')
879  handledisp = com_get_attribute_handle(trim(winname)//'.disp')
880 
881  handleoption = com_get_function_handle('Rocflu-MOP.set_value')
882  CALL com_call_function(handleoption,2,'inverted',1)
883 
884 ! *****************************************************************************
885 ! Copy grid data to old grid
886 !
887 ! This will only be done for non-Newton-Krylov solvers since that implicit
888 ! solver will use displacement ramping and hense will have to control when
889 ! the grid is stored.
890 ! *****************************************************************************
891 
892  IF ( global%solverType .NE. solv_implicit_nk ) THEN
893  DO ireg = 1,global%nRegionsLocal
894  pgrid => regions(ireg)%grid
895  pgridold => regions(ireg)%gridOld
896 
897  DO icg = 1,pgrid%nCellsTot ! Explicit copy to avoid ASCI White problem
898  pgridold%vol(icg) = pgrid%vol(icg)
899  END DO ! icg
900 
901  DO ivg = 1,pgrid%nVertTot ! Explicit copy to avoid ASCI White problem
902  pgridold%xyz(xcoord,ivg) = pgrid%xyz(xcoord,ivg)
903  pgridold%xyz(ycoord,ivg) = pgrid%xyz(ycoord,ivg)
904  pgridold%xyz(zcoord,ivg) = pgrid%xyz(zcoord,ivg)
905  END DO ! iv
906  END DO ! iReg
907  END IF ! global%solverType
908 
909 ! ******************************************************************************
910 ! Initialize displacements to zero and impose patch displacements on vertex
911 ! coordinates. NOTE this is different from other mesh motion routines because
912 ! Rocmop ignores displacement array on entry and requires that coordinates
913 ! already have boundary displacement added. NOTE pass in non-zero displacements
914 ! to Rocmop for thresholding.
915 ! ******************************************************************************
916  dispmax = 0.0_rfreal
917  DO ireg = 1,global%nRegionsLocal
918  pgrid => regions(ireg)%grid
919  pgridold => regions(ireg)%gridOld
920 
921  pdisp => pgrid%disp
922  pxyz => pgrid%xyz
923  pxyzold => pgridold%xyz
924 
925  DO ivg = 1,pgrid%nVertTot
926  pdisp(xcoord,ivg) = 0.0_rfreal
927  pdisp(ycoord,ivg) = 0.0_rfreal
928  pdisp(zcoord,ivg) = 0.0_rfreal
929  END DO ! ivg
930 
931  DO ipatch = 1,pgrid%nPatches
932  ppatch => regions(ireg)%patches(ipatch)
933 
934  DO ivl = 1,ppatch%nBVert
935  ivg = ppatch%bv(ivl)
936 
937  pxyz(xcoord,ivg) = pxyzold(xcoord,ivg) + ppatch%dXyz(xcoord,ivl)
938  pxyz(ycoord,ivg) = pxyzold(ycoord,ivg) + ppatch%dXyz(ycoord,ivl)
939  pxyz(zcoord,ivg) = pxyzold(zcoord,ivg) + ppatch%dXyz(zcoord,ivl)
940 
941 
942 ! Pass in displacements for displacement thresholding
943  pdisp(xcoord,ivg) = ppatch%dXyz(xcoord,ivl)
944  pdisp(ycoord,ivg) = ppatch%dXyz(ycoord,ivl)
945  pdisp(zcoord,ivg) = ppatch%dXyz(zcoord,ivl)
946 !
947  END DO ! ivl
948  END DO ! iPatch
949  IF (global%checkLevel == check_high) THEN
950  DO ipatch = 1,pgrid%nPatches
951  ppatch => regions(ireg)%patches(ipatch)
952 
953  DO ivl = 1,ppatch%nBVert
954  ivg = ppatch%bv(ivl)
955 
956  disptot = pdisp(xcoord,ivg)*pdisp(xcoord,ivg) + &
957  pdisp(ycoord,ivg)*pdisp(ycoord,ivg) + &
958  pdisp(zcoord,ivg)*pdisp(zcoord,ivg)
959  IF(disptot > dispmax) THEN
960  dispmax = disptot
961  ENDIF
962 
963  END DO ! ivl
964  END DO ! iPatch
965  ENDIF
966 
967  END DO ! iReg
968 
969  IF (global%checkLevel == check_high) THEN
970  disptot = dispmax
971  CALL mpi_reduce(disptot,dispmax,1,mpi_rfreal,mpi_max, &
972  masterproc,global%mpiComm,global%error)
973  IF ( global%error /= err_none ) THEN
974  CALL errorstop(global,err_mpi_trouble,__line__)
975  END IF ! global%errorFlag
976  IF ( global%myProcid == masterproc .AND. &
977  global%verbLevel >= verbose_high) THEN
978  dispmax = sqrt(dispmax)
979  WRITE(stdout,'(A,3X,A,1X,E13.6)') solver_name, &
980  'Maximum nodal displacement from Rocstar:',dispmax
981  END IF ! global%myProcid
982  ENDIF
983 
984 ! ******************************************************************************
985 ! Smooth displacements through Roccom
986 ! ******************************************************************************
987 
988  IF ( global%myProcid == masterproc .AND. &
989  global%verbLevel >= verbose_high ) THEN
990  WRITE(stdout,'(A,1X,A)') solver_name,'Smoothing grid with Rocmop...'
991  END IF ! global%myProcid
992 
993  CALL com_call_function(handlesmooth,2,handlepmesh,handledisp)
994 
995  CALL mpi_barrier(global%mpiComm,global%error)
996  IF ( global%myProcid == masterproc .AND. &
997  global%verbLevel >= verbose_high ) THEN
998  WRITE(stdout,'(A,1X,A)') solver_name,'Done smoothing grid with Rocmop.'
999  END IF ! global%myProcid
1000 
1001  disptot = 0.0
1002  dispmax = 0.0
1003  IF (global%checkLevel == check_high) THEN
1004  DO ireg = 1,global%nRegionsLocal
1005  pgrid => regions(ireg)%grid
1006  pdisp => pgrid%disp
1007  DO ipatch = 1,pgrid%nPatches
1008  ppatch => regions(ireg)%patches(ipatch)
1009  DO ivl = 1,ppatch%nBVert
1010  ivg = ppatch%bv(ivl)
1011  pdisp(xcoord,ivg) = 0.0_rfreal
1012  pdisp(ycoord,ivg) = 0.0_rfreal
1013  pdisp(zcoord,ivg) = 0.0_rfreal
1014  disptot = pdisp(xcoord,ivg)*pdisp(xcoord,ivg) + &
1015  pdisp(ycoord,ivg)*pdisp(ycoord,ivg) + &
1016  pdisp(zcoord,ivg)*pdisp(zcoord,ivg)
1017  IF(disptot > dispmax) THEN
1018  dispmax = disptot
1019  ENDIF
1020  END DO ! ivl
1021  END DO ! iPatch
1022  END DO ! iReg
1023  disptot = dispmax
1024  CALL mpi_reduce(disptot,dispmax,1,mpi_rfreal,mpi_max, &
1025  masterproc,global%mpiComm,global%error)
1026  IF ( global%error /= err_none ) THEN
1027  CALL errorstop(global,err_mpi_trouble,__line__)
1028  END IF ! global%errorFlag
1029  IF (dispmax /= 0.0) THEN
1030  IF ( global%myProcid == masterproc .AND. &
1031  global%verbLevel >= verbose_none) THEN
1032  dispmax = sqrt(dispmax)
1033  WRITE(stdout,'(A,3X,A,1X,E13.6)') solver_name, &
1034  '***WARNING - NONZERO SURFACE DISP FROM ROCMOP:',&
1035  dispmax
1036  END IF ! global%myProcid
1037  ENDIF
1038  ENDIF
1039 ! ******************************************************************************
1040 ! Update coordinates
1041 ! ******************************************************************************
1042 
1043  DO ireg = 1,global%nRegionsLocal
1044  pgrid => regions(ireg)%grid
1045  pdisp => pgrid%disp
1046  pxyz => pgrid%xyz
1047 
1048  DO ivg = 1,pgrid%nVertTot
1049  pxyz(xcoord,ivg) = pxyz(xcoord,ivg) + pdisp(xcoord,ivg)
1050  pxyz(ycoord,ivg) = pxyz(ycoord,ivg) + pdisp(ycoord,ivg)
1051  pxyz(zcoord,ivg) = pxyz(zcoord,ivg) + pdisp(zcoord,ivg)
1052  END DO ! ivg
1053  END DO ! iReg
1054 
1055  IF (global%checkLevel == check_high) THEN
1056  disptot = 0.0
1057  dispmax = 0.0
1058 
1059  DO ireg = 1,global%nRegionsLocal
1060  pgrid => regions(ireg)%grid
1061  pdisp => pgrid%disp
1062 
1063  DO ivg = 1,pgrid%nVertTot
1064  disptot = pdisp(xcoord,ivg)*pdisp(xcoord,ivg)+ &
1065  pdisp(ycoord,ivg)*pdisp(ycoord,ivg)+ &
1066  pdisp(zcoord,ivg)*pdisp(zcoord,ivg)
1067  IF(disptot > dispmax) THEN
1068  dispmax = disptot
1069  ENDIF
1070  END DO ! ivg
1071 
1072  END DO ! iReg
1073 
1074  disptot = dispmax
1075  CALL mpi_reduce(disptot,dispmax,1,mpi_rfreal,mpi_max, &
1076  masterproc,global%mpiComm,global%error)
1077  IF ( global%error /= err_none ) THEN
1078  CALL errorstop(global,err_mpi_trouble,__line__)
1079  END IF ! global%errorFlag
1080  IF ( global%myProcid == masterproc .AND. &
1081  global%verbLevel >= verbose_high) THEN
1082  dispmax = sqrt(dispmax)
1083  WRITE(stdout,'(A,3X,A,1X,E13.6)') solver_name, &
1084  'Maximum nodal displacement from Rocmop:',dispmax
1085  END IF ! global%myProcid
1086 
1087  END IF ! global%checkLevel
1088 
1089 ! ******************************************************************************
1090 ! End
1091 ! ******************************************************************************
1092 
1093  IF ( global%myProcid == masterproc .AND. &
1094  global%verbLevel >= verbose_high ) THEN
1095  WRITE(stdout,'(A,1X,A)') solver_name,'Moving grid done.'
1096  END IF ! global%myProcid
1097 
1098  CALL deregisterfunction(global)
1099 
1100 END SUBROUTINE rflu_genx_movegrid
1101 
1102 
1103 
1104 
1105 
1106 
1107 
1108 
1109 END MODULE rflu_modrocstartools
1110 
1111 ! ******************************************************************************
1112 !
1113 ! RCS Revision history:
1114 !
1115 ! $Log: RFLU_ModGENXTools.F90,v $
1116 ! Revision 1.29 2008/12/06 08:44:21 mtcampbe
1117 ! Updated license.
1118 !
1119 ! Revision 1.28 2008/11/19 22:17:33 mtcampbe
1120 ! Added Illinois Open Source License/Copyright
1121 !
1122 ! Revision 1.27 2008/09/26 15:53:02 rfiedler
1123 ! Do not apply planar constraints to nodes with vanishing displacements (for BSM).
1124 !
1125 ! Revision 1.26 2008/09/17 20:14:41 rfiedler
1126 ! Reduce tolerance for small displacements.
1127 !
1128 ! Revision 1.25 2008/09/11 22:42:04 rfiedler
1129 ! Do not constrain nodes that have 0 displacements -- for BSM.
1130 !
1131 ! Revision 1.24 2008/06/20 19:31:32 rfiedler
1132 ! Uses sign of HeadEnd - AftEnd to determine direction of rocket.
1133 !
1134 ! Revision 1.23 2008/01/31 22:47:28 mtcampbe
1135 ! added default coordinate shift of 0.0 which should be used when planar
1136 ! constraints are considered
1137 !
1138 ! Revision 1.22 2008/01/14 22:08:30 mtcampbe
1139 ! added planar constr
1140 !
1141 ! Revision 1.21 2007/04/20 16:07:49 mtcampbe
1142 ! Updating for burnout support function RFLU_GENX_InitBFLAG
1143 !
1144 ! Revision 1.20 2007/04/14 14:08:50 mtcampbe
1145 ! Cleaned up, bug fixes to constraints for mixed meshes, updated for ROCKET inp section
1146 !
1147 ! Revision 1.19 2007/02/06 18:12:10 mtcampbe
1148 ! Attempt to fix surface node mismatch problem by zeroing tiny surface displacements
1149 ! received from Rocmop. Currently, this will happen only if checking is high.
1150 !
1151 ! Revision 1.18 2006/11/30 16:50:37 mtcampbe
1152 ! Fixed 2 constraint code bugs: XyzOld changed to Xyz, and now looping over
1153 ! all patches to limit motion instead of just burning patches.
1154 !
1155 ! Revision 1.17 2006/11/13 19:26:15 mtcampbe
1156 ! New constraint codes and displacement checking
1157 !
1158 ! Revision 1.16 2006/09/10 16:57:51 mtcampbe
1159 ! Added the constraint displacement routine.
1160 !
1161 ! Revision 1.15 2006/02/08 21:13:02 hdewey2
1162 ! Deactivating grid copy for implicit solver bcos of disp ramping
1163 !
1164 ! Revision 1.14 2005/09/22 16:16:17 mtcampbe
1165 ! Fixed checking bug
1166 !
1167 ! Revision 1.13 2005/09/22 16:02:43 mtcampbe
1168 ! Re-enabled displacement passing, added displacement checking for grid motion
1169 !
1170 ! Revision 1.12 2005/09/16 00:44:20 mtcampbe
1171 ! Emergency bugfix - disabled displacement passing to Rocmop
1172 !
1173 ! Revision 1.11 2005/09/14 21:32:22 haselbac
1174 ! Bug fix: Disps were applied several times for bverts shared betw patches
1175 !
1176 ! Revision 1.10 2005/09/04 16:32:25 mtcampbe
1177 ! Changed to pass in mesh displacements to Rocmop
1178 !
1179 ! Revision 1.9 2005/09/01 16:04:42 mtcampbe
1180 ! Removed control calls to Rocmop which have been replaced by RocmopControl.txt
1181 !
1182 ! Revision 1.8 2005/06/20 21:24:50 haselbac
1183 ! Bug fix: Removed IF on pPatch%movePatchDir
1184 !
1185 ! Revision 1.7 2005/06/09 20:20:49 haselbac
1186 ! Now use movePatchDir instead of movePatch and smoothGrid
1187 !
1188 ! Revision 1.6 2005/06/06 22:44:38 rfiedler
1189 ! Reduce default Rocmop verbosity to 0.
1190 !
1191 ! Revision 1.5 2005/04/15 15:06:57 haselbac
1192 ! Cosmetics only
1193 !
1194 ! Revision 1.4 2005/04/02 22:14:29 haselbac
1195 ! Added setting of method option for mesh smoother
1196 !
1197 ! Revision 1.3 2004/12/08 14:43:01 haselbac
1198 ! Bug fixes: Pass flag for inverted orientation and patch smoothing
1199 !
1200 ! Revision 1.2 2004/10/22 14:01:57 haselbac
1201 ! Adapted code to work with Rocmop
1202 !
1203 ! Revision 1.1 2004/10/19 19:27:32 haselbac
1204 ! Initial revision
1205 !
1206 ! ******************************************************************************
1207 
1208 
1209 
1210 
1211 
1212 
1213 
1214 
1215 
sign
static SURF_BEGIN_NAMESPACE double sign(double x)
Definition: compute_curvature.C:31
y
void int int REAL REAL * y
Definition: read.cpp:74
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
modgrid::t_grid
Definition: ModGrid.F90:56
sqrt
double sqrt(double d)
Definition: double.h:73
rflu_modrocstartools::rflu_genx_constraindisp
subroutine, public rflu_genx_constraindisp(pRegion)
Definition: RFLU_ModRocstarTools.F90:145
z
void int int int REAL REAL REAL * z
Definition: write.cpp:76
rflu_modrocstartools::rflu_genx_initbflag
subroutine, public rflu_genx_initbflag(pRegion)
Definition: RFLU_ModRocstarTools.F90:551
x
void int int REAL * x
Definition: read.cpp:74
rflu_modrocstartools::rflu_genx_movegrid
subroutine, public rflu_genx_movegrid(regions)
Definition: RFLU_ModRocstarTools.F90:829
rflu_modrocstartools
Definition: RFLU_ModRocstarTools.F90:39
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
modbndpatch::t_patch
Definition: ModBndPatch.F90:91