Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLO_ModMoveGridConform.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 for frame grid-motion routines.
26 !
27 ! Description: None.
28 !
29 ! Notes: RFLO_ModMoveGridFrame can be selected from several files:
30 ! RFLO_ModMoveGridConform :
31 ! - ridges and block-boundaries are moved the same way as in
32 ! RFLO_MoveGridGlobal
33 ! - TFI of edges and surfaces are defined per block-boundaries, not
34 ! per patches
35 ! - partially external boundMoved(iBound) is not moved by mgFrameEdges
36 ! and mgFrameSurfaces, instead they wait to be moved by adjacent
37 ! block (in mgFrameInterfaces)
38 ! RFLO_ModMoveGridNconform :
39 ! - TFI of edges is defined per patch while that of surfaces is defined
40 ! per block-boundaries, in order to move interior block corners more
41 ! effectively
42 ! - partially external boundMoved(iBound) is not moved by mgFrameEdges
43 ! and mgFrameSurfaces, instead they wait to be moved by adjacent
44 ! block (in mgFrameInterfaces)
45 ! RFLO_ModMoveGridNconform1 :
46 ! - TFI of edges and surfaces are defined per patch, not per
47 ! block-boundaries
48 ! - patches at partially external boundMoved(iBound) is moved by
49 ! mgFrameEdges and mgFrameSurfaces, external patches are restored
50 ! afterwards
51 ! - unmatched interface patches are then made match in
52 ! mgFrameInterfaces
53 ! RFLO_ModMoveGridNconform2 :
54 ! - same as RFLO_ModMoveGridNconform1, except number of neighbors is
55 ! user-input instead of fixed to 6
56 ! RFLO_ModMoveGridNconform3 :
57 ! - enhancement from RFLO_ModMoveGridNconform2, by orthogonality
58 ! to the block surfaces containing solid surface in determining block
59 ! corners motion
60 !
61 ! ******************************************************************************
62 !
63 ! $Id: RFLO_ModMoveGridConform.F90,v 1.33 2009/08/27 14:04:50 mtcampbe Exp $
64 !
65 ! Copyright: (c) 2004 by the University of Illinois
66 !
67 ! ******************************************************************************
68 
70 
71  USE modglobal, ONLY : t_global
72  USE moddatastruct, ONLY: t_region
73  USE modgrid, ONLY : t_grid
74  USE modbndpatch, ONLY : t_patch
75  USE modparameters
76  USE moddatatypes
77  USE moderror
78  USE modmpi
79 
80  IMPLICIT NONE
81 
82  PRIVATE
83  PUBLIC :: rflo_movegridframe, &
87 
93 
94 ! private : RFLO_MgFrameSurface
95 ! RFLO_MgFrameInterfaces
96 
97 ! ******************************************************************************
98 ! Declarations and definitions
99 ! ******************************************************************************
100 
101  CHARACTER(CHRLEN) :: RCSIdentString = &
102  '$RCSfile: RFLO_ModMoveGridConform.F90,v $ $Revision: 1.33 $'
103 
104 ! ******************************************************************************
105 ! Routines
106 ! ******************************************************************************
107 
108  CONTAINS
109 
110 !******************************************************************************
111 !
112 ! Purpose: redistribute grid nodes according to the movement of the
113 ! boundaries. This function smoothes the grid globally by
114 ! volume mesh smoothing based on Laplacian propagation.
115 !
116 ! Description: none.
117 !
118 ! Input: regions = data of all grid regions.
119 !
120 ! Output: regions%levels%grid%xyz = new grid coordinates.
121 !
122 ! Notes: grid%xyz temporarily stores nodal displacements. The deformation
123 ! is applied to the finest grid first.
124 !
125 !******************************************************************************
126 
127 SUBROUTINE rflo_movegridframe( regions )
128 
137 
138  IMPLICIT NONE
139 
140 #ifdef GENX
141  include 'roccomf90.h'
142 #endif
143 
144 ! ... parameters
145  TYPE(t_region), POINTER :: regions(:)
146 
147 ! ... loop variables
148  INTEGER :: ireg, iter, ipatch, ijk
149 
150 ! ... local variables
151  LOGICAL :: somemoved, someremesh
152 
153  INTEGER :: bctype, iremesh, jremesh, nremesh, itype
154 
155  REAL(RFREAL) :: resid, globalresid
156  REAL(RFREAL), POINTER :: xyz(:,:), xyzold(:,:)
157 
158  TYPE(t_grid), POINTER :: grid, gridold
159  TYPE(t_global), POINTER :: global
160  TYPE(t_patch), POINTER :: patch
161 #ifdef GENX
162  DOUBLE PRECISION :: dalpha
163 #endif
164 
165 !******************************************************************************
166 
167  global => regions(1)%global
168 
169  CALL registerfunction( global,'RFLO_MoveGridFrame',&
170  'RFLO_ModMoveGridConform.F90' )
171 
172  itype=2
173 
174 #ifdef GENX
175 ! update geometry buffers -----------------------------------------------------
176 
177  dalpha = global%dtMin/global%dTimeSystem
178  CALL com_call_function( global%genxHandleGm,1,dalpha )
179 #endif
180 
181 ! receive and distribute deformations for each region -------------------------
182 
183  CALL rflo_mgframesurfaces( regions,somemoved,itype )
184 
185 ! fix interfaces between regions ----------------------------------------------
186 
187  IF (somemoved) THEN
188  CALL rflo_mgframeinterfaces( regions,itype )
189  ENDIF
190 
191 ! update grid, dummy, corner and edge cells -----------------------------------
192 
193  DO ireg=1,global%nRegions
194  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
195  regions(ireg)%active==active .AND. & ! on my processor
196  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
197 
198 ! --- change the interior grid
199 
200  grid => regions(ireg)%levels(1)%grid
201  gridold => regions(ireg)%levels(1)%gridOld
202  CALL rflo_changeinteriorgrid( regions(ireg),grid%boundMoved, &
203  grid%edgeMoved,grid%arcLen12, &
204  grid%arcLen34,grid%arcLen56, &
205  gridold%xyzOld,grid%xyz )
206 
207 ! --- update coarse grids and dummy cells
208 
209  CALL rflo_generatecoarsegrids( regions(ireg) ) ! coarsen finest grid
210  CALL rflo_copygeometrydummy( regions(ireg) ) ! copy to dummy nodes
211  CALL rflo_extrapolategeometry( regions(ireg) ) ! extrapolate
212  ENDIF ! region on this processor and active, grid moving
213  ENDDO ! iReg
214  CALL rflo_exchangegeometry( regions ) ! exchange geometry
215 
216 ! smooth grid by solving Laplace equation -------------------------------------
217 
218  IF (global%moveGridNiter < 1) THEN
219  IF (global%verbLevel >= verbose_high) THEN
220  IF (global%myProcid == masterproc) THEN
221  WRITE(stdout,4000) solver_name,global%skewness,global%minVol
222  WRITE(stdout,1000) solver_name, global%moveGridNiter, &
223  global%moveGridAmplifX,global%moveGridAmplifY, &
224  global%moveGridAmplifZ,global%moveGridPower
225  ENDIF ! masterproc
226  ENDIF ! verbLevel
227  goto 888
228  ENDIF ! niter<1
229 
230  IF (somemoved) THEN
231  DO iter=1,global%moveGridNiter
232  CALL rflo_laplacegridsmoo( regions,resid )
233  ENDDO
234 
235  IF (global%verbLevel >= verbose_high) THEN
236 #ifdef MPI
237  CALL mpi_reduce( resid,globalresid,1,mpi_rfreal,mpi_sum, &
238  masterproc,global%mpiComm,global%mpierr )
239  IF (global%mpierr /= 0) CALL errorstop( global,err_mpi_trouble,__line__ )
240 #else
241  globalresid = resid
242 #endif
243  IF (global%myProcid == masterproc) THEN
244  WRITE(stdout,4000) solver_name,global%skewness,global%minVol
245 
246  IF (global%moveGridScheme==movegrid_frame) THEN
247  WRITE(stdout,2000) solver_name, &
248  global%moveGridNiter, &
249  global%moveGridAmplifX,global%moveGridAmplifY, &
250  global%moveGridAmplifZ,global%moveGridPower, &
251  sqrt(globalresid)
252  ELSEIF (global%moveGridScheme==movegrid_foms) THEN
253  WRITE(stdout,3000) solver_name, &
254  global%moveGridNiter, &
255  global%moveGridAmplifX,global%moveGridAmplifY, &
256  global%moveGridAmplifZ,global%moveGridPower, &
257  global%moveGridWeight,global%moveGridOrthCell, &
258  sqrt(globalresid)
259  ENDIF
260  ENDIF
261  ENDIF ! verbLevel
262  ENDIF ! someMoved
263 
264 ! update grid, dummy, corner and edge cells -----------------------------------
265 
266  DO ireg=1,global%nRegions
267  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
268  regions(ireg)%active==active .AND. & ! on my processor
269  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
270 
271 ! --- change xyz from coordinates to deformations
272 
273  xyz => regions(ireg)%levels(1)%grid%xyz
274  xyzold => regions(ireg)%levels(1)%gridOld%xyz
275 
276  DO ijk=lbound(xyz,2),ubound(xyz,2)
277  xyz(xcoord,ijk) = xyz(xcoord,ijk) - xyzold(xcoord,ijk)
278  xyz(ycoord,ijk) = xyz(ycoord,ijk) - xyzold(ycoord,ijk)
279  xyz(zcoord,ijk) = xyz(zcoord,ijk) - xyzold(zcoord,ijk)
280  ENDDO
281 
282 ! --- redistribute deformations at boundaries
283 
284  grid => regions(ireg)%levels(1)%grid
285  gridold => regions(ireg)%levels(1)%gridOld
286  grid%boundMoved(:) = .true.
287  grid%edgeMoved(:) = .true.
288  DO ipatch=1,regions(ireg)%nPatches
289  patch => regions(ireg)%levels(1)%patches(ipatch)
290  bctype = patch%bcType
291 ! IF ((bcType .eq. BC_SYMMETRY .AND. bcType<=BC_SYMMETRY+BC_RANGE)) THEN
292  IF (bctype .EQ. bc_symmetry) THEN
293  grid%boundMoved(patch%lbound) = .false.
294  ENDIF ! bcType
295  ENDDO ! iPatch
296  CALL rflo_boundarydeformation( regions(ireg),grid%boundMoved, &
297  grid%edgeMoved,grid%arcLen12, &
298  grid%arcLen34,grid%arcLen56, &
299  gridold%xyzOld,grid%xyz )
300 
301 ! --- change xyz from deformations to coordinates
302 
303  CALL rflo_changeinteriorgrid( regions(ireg),grid%boundMoved, &
304  grid%edgeMoved,grid%arcLen12, &
305  grid%arcLen34,grid%arcLen56, &
306  gridold%xyzOld,grid%xyz )
307 
308 ! --- update coarse grids and dummy cells
309 
310  CALL rflo_generatecoarsegrids( regions(ireg) ) ! coarsen finest grid
311  CALL rflo_copygeometrydummy( regions(ireg) ) ! copy to dummy nodes
312  CALL rflo_extrapolategeometry( regions(ireg) ) ! extrapolate
313  ENDIF ! region on this processor and active, grid moving
314  ENDDO ! iReg
315 
316  CALL rflo_exchangegeometry( regions ) ! exchange geometry
317 
318 888 CONTINUE
319 
320 ! calculate new metrics and grid speeds ---------------------------------------
321 
322  someremesh = .false.
323  iremesh = 0
324  DO ireg=1,global%nRegions
325  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
326  regions(ireg)%active==active .AND. & ! on my processor
327  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
328  CALL rflo_calcfacevectors( regions(ireg) ) ! faces
329  CALL rflo_calccontrolvolumes( regions(ireg) ) ! volumes
330  CALL rflo_calccellcentroids( regions(ireg) ) ! cell centroids
331  IF (global%moveGridScheme==movegrid_foms) &
332  CALL rflo_calcfacecentroids( regions(ireg) ) ! face centroids
333  IF (regions(ireg)%mixtInput%faceEdgeAvg==fe_avg_linear) &
334  CALL rflo_c2favgcoeffs( regions(ireg) ) ! cell2face averaging
335  CALL rflo_c2eavgcoeffs( regions(ireg) ) ! cell2edge averaging
336  CALL rflo_checkmetrics( ireg,regions(ireg) ) ! check metrics
337 ! IF (regions(iReg)%levels(1)%grid%remesh==1) THEN
338 ! CALL RFLO_GridRemesh( regions(iReg) ) ! grid remeshing
339 ! iRemesh=1
340 ! ENDIF
341  CALL rflo_calcgridspeeds( regions(ireg) ) ! grid speeds
342  ENDIF ! region on this processor and active, grid moving
343  ENDDO ! iReg
344 
345 #ifdef MPI
346  CALL mpi_allreduce( iremesh, nremesh, 1, mpi_integer, mpi_sum, &
347  global%mpiComm, global%mpierr )
348  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
349  IF (nremesh > 0) someremesh = .true.
350 #endif
351 
352  IF (someremesh) THEN
353  CALL rflo_exchangegeometry( regions ) ! exchange geometry
354  DO ireg=1,global%nRegions
355  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
356  regions(ireg)%active==active .AND. & ! on my processor
357  iremesh==1) THEN ! and remeshing
358  CALL rflo_calcfacevectors( regions(ireg) ) ! faces
359  CALL rflo_calccontrolvolumes( regions(ireg) ) ! volumes
360  CALL rflo_calccellcentroids( regions(ireg) ) ! cell centroids
361  IF (global%moveGridScheme==movegrid_foms) &
362  CALL rflo_calcfacecentroids( regions(ireg) ) ! face centroids
363  IF (regions(ireg)%mixtInput%faceEdgeAvg==fe_avg_linear) &
364  CALL rflo_c2favgcoeffs( regions(ireg) ) ! cell2face averaging
365  CALL rflo_c2eavgcoeffs( regions(ireg) ) ! cell2edge averaging
366  ENDIF ! region on this processor and active, grid moving
367  ENDDO ! iReg
368  ENDIF
369 
370 ! finalize --------------------------------------------------------------------
371 
372  CALL deregisterfunction( global )
373 
374 1000 FORMAT(a,1x,'Global-TFI grid motion:',i6,4(1pe9.2))
375 2000 FORMAT(a,1x,'Global-Weighted-Laplacian grid motion:',i6,4(1pe9.2),1pe13.4)
376 3000 FORMAT(a,1x,'Global-Orthogonal-Laplacian gridmotion:',i4,6(1pe9.2),1pe10.2)
377 4000 FORMAT(a,1x,'global skewness, minvol:',2(1pe14.5))
378 
379 END SUBROUTINE rflo_movegridframe
380 
381 !******************************************************************************
382 !
383 ! Purpose: search for corner points including those of internal patches
384 !
385 ! Description: none.
386 !
387 ! Input: regions = data of current region.
388 !
389 ! Output: grid%nCorns = number of corner points in each region
390 ! grid%ijkCorn = ijkValue of each corner
391 !
392 ! Notes: In this module, this subroutine serves only to allocate memory
393 ! of grid%regCorn, grid%regCornOld, grid%regCornOrig and grid%nghbor,
394 ! remaing kernels have no effect.
395 !
396 !******************************************************************************
397 
398 SUBROUTINE rflo_mgframecornpoints( regions )
399 
400  USE modinterfaces, ONLY : rflo_getnodeoffset, &
402 
403  IMPLICIT NONE
404 #include "Indexing.h"
405 
406 ! ... parameters
407  TYPE(t_region), POINTER :: regions(:)
408 
409 ! ... loop variables
410  INTEGER :: l, ipatch, ireg, ipcorn, intcorn
411 
412 ! ... local variables
413  INTEGER, PARAMETER :: ncmax=100
414  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
415  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend
416  INTEGER :: iptc, jptc, kptc, iblk, jblk, kblk, ijkcurr
417  INTEGER :: inoff, ijnoff, lbound, regnc, errfl
418  INTEGER :: ijkcorn(ncmax)
419  LOGICAL :: wasfound
420 
421  TYPE(t_patch), POINTER :: patch
422  TYPE(t_grid), POINTER :: grid
423  TYPE(t_global), POINTER :: global
424 
425 !******************************************************************************
426 
427  global => regions(1)%global
428 
429  CALL registerfunction( global,'RFLO_MgFrameCornPoints',&
430  'RFLO_ModMoveGridConform.F90' )
431 
432 ! search for block and patch corners in each region ---------------------------
433 
434  ilev = 1
435 
436  DO ireg = 1,global%nRegions
437  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
438  regions(ireg)%active==active) THEN ! on my processor
439 
440  grid => regions(ireg)%levels(ilev)%grid
441 
442  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
443  jpnbeg,jpnend,kpnbeg,kpnend )
444  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
445 
446 ! --- search for internal patch corners
447 
448  grid%nCorns(ireg) = 8
449  ijkcorn(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
450  ijkcorn(2) = indijk(ibeg,jbeg,kend,inoff,ijnoff)
451  ijkcorn(3) = indijk(ibeg,jend,kend,inoff,ijnoff)
452  ijkcorn(4) = indijk(ibeg,jend,kbeg,inoff,ijnoff)
453  ijkcorn(5) = indijk(iend,jbeg,kbeg,inoff,ijnoff)
454  ijkcorn(6) = indijk(iend,jbeg,kend,inoff,ijnoff)
455  ijkcorn(7) = indijk(iend,jend,kend,inoff,ijnoff)
456  ijkcorn(8) = indijk(iend,jend,kbeg,inoff,ijnoff)
457 
458  DO ipatch=1,regions(ireg)%nPatches
459  patch => regions(ireg)%levels(ilev)%patches(ipatch)
460  lbound = patch%lbound
461 
462  CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
463  ibeg,iend,jbeg,jend,kbeg,kend )
464 
465  DO ipcorn = 1,4 ! patch corners
466  IF (lbound==1 .OR. lbound==2) THEN
467  iptc = ibeg
468  IF (lbound==1) iblk = ipnbeg
469  IF (lbound==2) iblk = ipnend
470  IF (ipcorn==1) THEN
471  jptc = jbeg
472  jblk = jpnbeg
473  kptc = kbeg
474  kblk = kpnbeg
475  ELSEIF (ipcorn==2) THEN
476  jptc = jbeg
477  jblk = jpnbeg
478  kptc = kend
479  kblk = kpnend
480  ELSEIF (ipcorn==3) THEN
481  jptc = jend
482  jblk = jpnend
483  kptc = kend
484  kblk = kpnend
485  ELSEIF (ipcorn==4) THEN
486  jptc = jend
487  jblk = jpnend
488  kptc = kbeg
489  kblk = kpnbeg
490  ENDIF
491  ELSEIF (lbound==3 .OR. lbound==4) THEN
492  jptc = jbeg
493  IF (lbound==3) jblk = jpnbeg
494  IF (lbound==4) jblk = jpnend
495  IF (ipcorn==1) THEN
496  kptc = kbeg
497  kblk = kpnbeg
498  iptc = ibeg
499  iblk = ipnbeg
500  ELSEIF (ipcorn==2) THEN
501  kptc = kend
502  kblk = kpnend
503  iptc = ibeg
504  iblk = ipnbeg
505  ELSEIF (ipcorn==3) THEN
506  kptc = kend
507  kblk = kpnend
508  iptc = iend
509  iblk = ipnend
510  ELSEIF (ipcorn==4) THEN
511  kptc = kbeg
512  kblk = kpnbeg
513  iptc = iend
514  iblk = ipnend
515  ENDIF ! ipCorn
516  ELSEIF (lbound==5 .OR. lbound==6) THEN
517  kptc = kbeg
518  IF (lbound==5) kblk = kpnbeg
519  IF (lbound==6) kblk = kpnend
520  IF (ipcorn==1) THEN
521  iptc = ibeg
522  iblk = ipnbeg
523  jptc = jbeg
524  jblk = jpnbeg
525  ELSEIF (ipcorn==2) THEN
526  iptc = ibeg
527  iblk = ipnbeg
528  jptc = jend
529  jblk = jpnend
530  ELSEIF (ipcorn==3) THEN
531  iptc = iend
532  iblk = ipnend
533  jptc = jend
534  jblk = jpnend
535  ELSEIF (ipcorn==4) THEN
536  iptc = iend
537  iblk = ipnend
538  jptc = jbeg
539  jblk = jpnbeg
540  ENDIF ! ipCorn
541  ENDIF ! lbound
542 
543  IF (iptc/=iblk .OR. jptc/=jblk .OR. kptc/=kblk) THEN
544  wasfound = .false.
545  ijkcurr = indijk(iptc,jptc,kptc,inoff,ijnoff)
546  DO intcorn=1,grid%nCorns(ireg)
547  IF (ijkcorn(intcorn)==ijkcurr) THEN
548  wasfound = .true.
549  ENDIF
550  ENDDO
551  IF (.NOT. wasfound) THEN
552  grid%nCorns(ireg) = grid%nCorns(ireg) +1
553  ijkcorn(grid%nCorns(ireg)) = ijkcurr
554  ENDIF
555  ENDIF
556  IF (grid%nCorns(ireg) >= ncmax) THEN
557  CALL errorstop( global,err_illegal_value,__line__, &
558  'too low ncMax in RFLO_ModMoveGridNconform/RFLO_MgFrameCornPoints')
559  ENDIF
560  ENDDO ! ipCorn
561  ENDDO ! iPatch
562 
563  regnc = grid%nCorns(ireg)
564  regnc = 8 ! note: this module assume fully conforming
565  ! blocking therefore only 8 block points is
566  ! considered, i.e those at block corners.
567  ! regNc is thus overwritten by 8.
568 
569  ALLOCATE( grid%ijkCorn( regnc,global%nRegions),stat=errfl )
570  global%error = errfl
571  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
572 
573  ALLOCATE( grid%regCorn( 3,regnc,global%nRegions),stat=errfl )
574  global%error = errfl
575  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
576 
577  ALLOCATE( grid%regCornOld( 3,regnc,global%nRegions),stat=errfl )
578  global%error = errfl
579  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
580 
581  ALLOCATE( grid%regCornOrig(3,regnc,global%nRegions),stat=errfl )
582  global%error = errfl
583  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
584 
585  ALLOCATE( grid%nghbor( 3,6,regnc) ,stat=errfl )
586  global%error = errfl
587  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
588 
589  DO l = 1,grid%nCorns(ireg)
590  grid%ijkCorn(l,ireg) = ijkcorn(l)
591  ENDDO
592 
593  ENDIF ! myProcid
594  ENDDO ! iReg
595 
596 ! finalize --------------------------------------------------------------------
597 
598  CALL deregisterfunction( global )
599 
600 END SUBROUTINE rflo_mgframecornpoints
601 
602 !******************************************************************************
603 !
604 ! Purpose: broadcast movements at 8 corner points of current region to all
605 ! regions
606 !
607 ! Description: none.
608 !
609 ! Input: regions = data of all grid regions.
610 !
611 ! Notes: upon first call by RFLO_InitGridProcedure, regions%levels%grid%xyz
612 ! contains grid coordinates, but on second call by RFLO_MgFrameSurface
613 ! regions%levels%grid%xyz contains grid movements.
614 !
615 !******************************************************************************
616 
617 SUBROUTINE rflo_mgframebroadcast( regions,iselect,iter )
618 
620  IMPLICIT NONE
621 
622 #include "Indexing.h"
623 
624 ! ... parameters
625  TYPE(t_region), POINTER :: regions(:)
626  INTEGER :: iselect, iter
627 
628 ! ... loop variables
629  INTEGER :: i, l, ireg, corner(8)
630 
631 ! ... local variables
632  INTEGER :: ilev, ncorns, regnc, errfl
633  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, inoff, ijnoff
634 
635  REAL(RFREAL), ALLOCATABLE :: rvar(:,:,:)
636  REAL(RFREAL), POINTER :: dxyz(:,:)
637 
638  TYPE(t_global), POINTER :: global
639  TYPE(t_grid), POINTER :: grid, gridold
640 
641 !******************************************************************************
642 
643  global => regions(1)%global
644 
645  CALL registerfunction( global,'RFLO_MgFrameBroadcast',&
646  'RFLO_ModMoveGridConform.F90' )
647 
648 ! store block corners and broadcast to all regions ----------------------------
649 
650  regnc = 8
651  ALLOCATE( rvar(xcoord:zcoord,regnc,global%nRegions), &
652  stat=errfl )
653  global%error = errfl
654  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
655  rvar = 0._rfreal
656 
657  ilev = 1
658 
659  DO ireg = 1,global%nRegions
660  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
661  regions(ireg)%active==active) THEN ! on my processor
662 
663  grid => regions(ireg)%levels(ilev)%grid
664 ! gridOld => regions(iReg)%levels(iLev)%gridOld
665 
666  IF (iter==1) THEN
667  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
668  jpnbeg,jpnend,kpnbeg,kpnend )
669  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
670 
671  dxyz => grid%xyz
672 
673  corner(1) = indijk(ipnbeg ,jpnbeg ,kpnbeg ,inoff,ijnoff)
674  corner(2) = indijk(ipnbeg ,jpnbeg ,kpnend ,inoff,ijnoff)
675  corner(3) = indijk(ipnbeg ,jpnend ,kpnend ,inoff,ijnoff)
676  corner(4) = indijk(ipnbeg ,jpnend ,kpnbeg ,inoff,ijnoff)
677  corner(5) = indijk(ipnend ,jpnbeg ,kpnbeg ,inoff,ijnoff)
678  corner(6) = indijk(ipnend ,jpnbeg ,kpnend ,inoff,ijnoff)
679  corner(7) = indijk(ipnend ,jpnend ,kpnend ,inoff,ijnoff)
680  corner(8) = indijk(ipnend ,jpnend ,kpnbeg ,inoff,ijnoff)
681 
682  IF (iselect==1) THEN
683  DO i=1,8
684  grid%regCornOld(xcoord,i,ireg) = dxyz(xcoord,corner(i))
685  grid%regCornOld(ycoord,i,ireg) = dxyz(ycoord,corner(i))
686  grid%regCornOld(zcoord,i,ireg) = dxyz(zcoord,corner(i))
687  rvar(:,i,ireg) = grid%regCornOld(:,i,ireg)
688  ENDDO
689  ELSE
690  DO i=1,8
691  grid%regCornOrig(xcoord,i,ireg) = dxyz(xcoord,corner(i))
692  grid%regCornOrig(ycoord,i,ireg) = dxyz(ycoord,corner(i))
693  grid%regCornOrig(zcoord,i,ireg) = dxyz(zcoord,corner(i))
694  rvar(:,i,ireg) = grid%regCornOrig(:,i,ireg)
695  ENDDO
696  ENDIF
697  ENDIF ! iter
698  ENDIF ! myProcid
699  ENDDO ! iReg
700 
701 #ifdef MPI
702  DO ireg = 1,global%nRegions
703  ncorns = regnc
704 
705  CALL mpi_bcast( rvar(xcoord:zcoord,1:ncorns,ireg),3*ncorns, &
706  mpi_rfreal,regions(ireg)%procId,global%mpiComm,global%mpierr )
707  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
708  ENDDO
709  CALL mpi_barrier( global%mpiComm,global%mpierr )
710 
711  DO ireg = 1,global%nRegions
712  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
713  regions(ireg)%active==active) THEN ! on my processor
714 
715  grid => regions(ireg)%levels(ilev)%grid
716  IF (iter == 1) THEN
717  IF (iselect==1) THEN
718  DO l=1,global%nRegions
719  grid%regCornOld(:,:,l) = rvar(:,:,l)
720  ENDDO
721  ELSE
722  DO l=1,global%nRegions
723  grid%regCornOrig(:,:,l) = rvar(:,:,l)
724  ENDDO
725  ENDIF
726  ELSE
727  DO l=1,global%nRegions
728  grid%regCornOld(:,:,l) = rvar(:,:,l)
729  ENDDO
730  ENDIF ! iter
731  ENDIF ! myProcid
732  ENDDO ! iReg
733 
734 ! DO iReg = 1,global%nRegions
735 ! IF (regions(iReg)%procid==global%myProcid .AND. & ! region active and
736 ! regions(iReg)%active==ACTIVE) THEN ! on my processor
737 ! grid => regions(1)%levels(iLev)%grid
738 ! DO i=1,8
739 ! write(*,*)iReg,i,grid%regCornOrig(XCOORD:ZCOORD,i,iReg)
740 ! ENDDO
741 ! ENDDO
742 ! ENDIF
743 #endif
744 
745 ! finalize --------------------------------------------------------------------
746 
747  CALL deregisterfunction( global )
748 
749 END SUBROUTINE rflo_mgframebroadcast
750 
751 !******************************************************************************
752 !
753 ! Purpose: search for six closest neighbors
754 !
755 ! Description: none.
756 !
757 ! Input: regions = data of current region.
758 !
759 ! Output: grid%nghbor = neighbouring points identified
760 !
761 ! Notes: none
762 !
763 !******************************************************************************
764 
765 SUBROUTINE rflo_mgframesrchneighbors( regions )
766 
769 
770  IMPLICIT NONE
771 
772 ! ... parameters
773  TYPE(t_region), POINTER :: regions(:)
774 
775 ! ... loop variables
776  INTEGER :: i, j, k, ipatch, ic, ireg, nc, nreg
777 
778 ! ... local variables
779  INTEGER :: ilev, bctype, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
780  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
781  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend
782  INTEGER :: ijknode(4), ncmin(6), nregmin(6), inoff, ijnoff, lbound, errfl
783  REAL(RFREAL) :: edgelen, ds, tol, distmin(6)
784  REAL(RFREAL), POINTER :: xyz(:,:)
785  REAL(RFREAL), ALLOCATABLE :: dist(:,:)
786 
787  TYPE(t_patch), POINTER :: patch
788  TYPE(t_grid), POINTER :: grid
789  TYPE(t_global), POINTER :: global
790 
791 !******************************************************************************
792 
793  global => regions(1)%global
794 
795  CALL registerfunction( global,'RFLO_MgFrameSrchNeighbors',&
796  'RFLO_ModMoveGridConform.F90' )
797 
798 ! search for six closest neighbours -------------------------------------------
799 
800  ALLOCATE( dist(8,global%nRegions), stat=errfl ); IF (errfl>0) goto 88
801 
802  ilev = 1
803 
804  DO ireg = 1,global%nRegions
805  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
806  regions(ireg)%active==active) THEN ! on my processor
807 
808  grid => regions(ireg)%levels(ilev)%grid
809 
810  CALL rflo_getdimensphys( regions(ireg),ilev,ipcbeg,ipcend, &
811  jpcbeg,jpcend,kpcbeg,kpcend )
812  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
813  jpnbeg,jpnend,kpnbeg,kpnend )
814  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
815 
816  xyz => regions(ireg)%levels(ilev)%grid%xyz
817 
818 ! --- calculate the shortest cell edge
819 
820  edgelen = 1.e+30_rfreal
821 
822  DO k=kpcbeg,kpcend
823  DO j=jpcbeg,jpcend
824  DO i=ipcbeg,ipcend
825  ijknode(1) = indijk(i ,j ,k ,inoff,ijnoff)
826  ijknode(2) = indijk(i+1,j ,k ,inoff,ijnoff)
827  ijknode(3) = indijk(i ,j+1,k ,inoff,ijnoff)
828  ijknode(4) = indijk(i ,j ,k+1,inoff,ijnoff)
829  ds = sqrt((xyz(xcoord,ijknode(2))-xyz(xcoord,ijknode(1)))**2+ &
830  (xyz(ycoord,ijknode(2))-xyz(ycoord,ijknode(1)))**2+ &
831  (xyz(zcoord,ijknode(2))-xyz(zcoord,ijknode(1)))**2)
832  edgelen = min(edgelen,ds)
833  ds = sqrt((xyz(xcoord,ijknode(3))-xyz(xcoord,ijknode(1)))**2+ &
834  (xyz(ycoord,ijknode(3))-xyz(ycoord,ijknode(1)))**2+ &
835  (xyz(zcoord,ijknode(3))-xyz(zcoord,ijknode(1)))**2)
836  edgelen = min(edgelen,ds)
837  ds = sqrt((xyz(xcoord,ijknode(4))-xyz(xcoord,ijknode(1)))**2+ &
838  (xyz(ycoord,ijknode(4))-xyz(ycoord,ijknode(1)))**2+ &
839  (xyz(zcoord,ijknode(4))-xyz(zcoord,ijknode(1)))**2)
840  edgelen = min(edgelen,ds)
841  ENDDO
842  ENDDO
843  ENDDO
844  tol = 1.e-5_rfreal*edgelen
845 
846  DO ic = 1,8
847  distmin(1:6) = 1.e+30_rfreal
848  ncmin(1:6) = 1
849  nregmin(1:6) = 1
850  DO nreg = 1,global%nRegions
851  DO nc = 1,8
852  dist(nc,nreg) = sqrt((grid%regCornOrig(xcoord,nc,nreg)- &
853  grid%regCornOrig(xcoord,ic,ireg))**2 + &
854  (grid%regCornOrig(ycoord,nc,nreg)- &
855  grid%regCornOrig(ycoord,ic,ireg))**2 + &
856  (grid%regCornOrig(zcoord,nc,nreg)- &
857  grid%regCornOrig(zcoord,ic,ireg))**2)
858 
859 ! -------- inhibitor check
860 ! IF (dist(nc,nReg)>edgeLen .AND. iReg==12 .AND. ic==5 .AND. &
861 ! (nReg==12 .OR. nReg==14 .OR. nReg==18 .OR. nReg==25 .OR. &
862 ! nReg==26 .OR. nReg==52 .OR. nReg==69)) &
863 ! write(*,*)'i',iReg,ic,nReg,nc,dist(nc,nReg)
864 
865 ! -------- titan4-240blocks check
866 ! IF (dist(nc,nReg)>edgeLen .AND. iReg==120 .AND. ic==6 .AND. &
867 ! (nReg==96 .OR. nReg==37 .OR. nReg==105 .OR. nReg==121 .OR. &
868 ! nReg==117 .OR. nReg==123 .OR. nReg==71 .OR. nReg==72 .OR. &
869 ! nReg==120)) write(*,*)'i',iReg,ic,nReg,nc,dist(nc,nReg)
870 
871  IF (dist(nc,nreg)<distmin(1) .AND. dist(nc,nreg)>edgelen) THEN
872  DO k = 6,2,-1
873  distmin(k) = distmin(k-1)
874  ncmin(k) = ncmin(k-1)
875  nregmin(k) = nregmin(k-1)
876  ENDDO
877  distmin(1) = dist(nc,nreg)
878  ncmin(1) = nc
879  nregmin(1) = nreg
880  ENDIF
881 
882  DO k = 2,6
883  IF (dist(nc,nreg) > (distmin(k-1) + tol) .AND. &
884  dist(nc,nreg) < (distmin(k) - tol)) THEN
885 ! ------------- titan4-240blocks check
886 ! IF (iReg==120 .AND. ic==6) write(*,*)'j',iReg,ic,nReg, &
887 ! nc,k,dist(nc,nReg),distMin(k-1),distMin(k)
888  DO j = 6,k+1,-1
889  distmin(j) = distmin(j-1)
890  ncmin(j) = ncmin(j-1)
891  nregmin(j) = nregmin(j-1)
892  ENDDO
893  distmin(k) = dist(nc,nreg)
894  ncmin(k) = nc
895  nregmin(k) = nreg
896  ENDIF
897  ENDDO
898 
899  ENDDO ! nc
900  ENDDO ! nReg
901 
902  DO k = 1,6
903  nc = ncmin(k)
904  nreg = nregmin(k)
905  grid%nghbor(1,k,ic) = nc
906  grid%nghbor(2,k,ic) = nreg
907  ENDDO ! k
908  ENDDO ! ic
909 
910 ! --- assign internal/external flag to block corners
911 
912  grid%nghbor(3,:,:) = 1
913 
914 ! --- corner 1
915  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(1)%interact).OR. &
916  (.NOT. regions(ireg)%levels(ilev)%edgeCells(1)%interact).OR. &
917  (.NOT. regions(ireg)%levels(ilev)%edgeCells(4)%interact).OR. &
918  (.NOT. regions(ireg)%levels(ilev)%edgeCells(9)%interact)) &
919  grid%nghbor(3,1:6,1) = 0
920 
921 ! --- corner 2
922  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(2)%interact).OR. &
923  (.NOT. regions(ireg)%levels(ilev)%edgeCells(1)%interact).OR. &
924  (.NOT. regions(ireg)%levels(ilev)%edgeCells(2)%interact).OR. &
925  (.NOT. regions(ireg)%levels(ilev)%edgeCells(10)%interact)) &
926  grid%nghbor(3,1:6,2) = 0
927 
928 ! --- corner 3
929  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(3)%interact).OR. &
930  (.NOT. regions(ireg)%levels(ilev)%edgeCells(2)%interact).OR. &
931  (.NOT. regions(ireg)%levels(ilev)%edgeCells(3)%interact).OR. &
932  (.NOT. regions(ireg)%levels(ilev)%edgeCells(11)%interact)) &
933  grid%nghbor(3,1:6,3) = 0
934 
935 ! --- corner 4
936  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(4)%interact).OR. &
937  (.NOT. regions(ireg)%levels(ilev)%edgeCells(3)%interact).OR. &
938  (.NOT. regions(ireg)%levels(ilev)%edgeCells(4)%interact).OR. &
939  (.NOT. regions(ireg)%levels(ilev)%edgeCells(12)%interact)) &
940  grid%nghbor(3,1:6,4) = 0
941 
942 ! --- corner 5
943  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(5)%interact).OR. &
944  (.NOT. regions(ireg)%levels(ilev)%edgeCells(5)%interact).OR. &
945  (.NOT. regions(ireg)%levels(ilev)%edgeCells(8)%interact).OR. &
946  (.NOT. regions(ireg)%levels(ilev)%edgeCells(9)%interact)) &
947  grid%nghbor(3,1:6,5) = 0
948 
949 ! --- corner 6
950  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(6)%interact).OR. &
951  (.NOT. regions(ireg)%levels(ilev)%edgeCells(5)%interact).OR. &
952  (.NOT. regions(ireg)%levels(ilev)%edgeCells(6)%interact).OR. &
953  (.NOT. regions(ireg)%levels(ilev)%edgeCells(10)%interact)) &
954  grid%nghbor(3,1:6,6) = 0
955 
956 ! --- corner 7
957  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(7)%interact).OR. &
958  (.NOT. regions(ireg)%levels(ilev)%edgeCells(6)%interact).OR. &
959  (.NOT. regions(ireg)%levels(ilev)%edgeCells(7)%interact).OR. &
960  (.NOT. regions(ireg)%levels(ilev)%edgeCells(11)%interact)) &
961  grid%nghbor(3,1:6,7) = 0
962 
963 ! --- corner 8
964  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(8)%interact).OR. &
965  (.NOT. regions(ireg)%levels(ilev)%edgeCells(7)%interact).OR. &
966  (.NOT. regions(ireg)%levels(ilev)%edgeCells(8)%interact).OR. &
967  (.NOT. regions(ireg)%levels(ilev)%edgeCells(12)%interact)) &
968  grid%nghbor(3,1:6,8) = 0
969 
970 ! --- additional search for external corners
971 
972  DO ipatch=1,regions(ireg)%nPatches
973  patch => regions(ireg)%levels(ilev)%patches(ipatch)
974  lbound = patch%lbound
975  bctype = patch%bcType
976 
977  CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
978  ibeg,iend,jbeg,jend,kbeg,kend )
979 
980  IF (patch%bcMotion == bc_external) THEN
981  IF (lbound==1) THEN
982  IF (jbeg==jpnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,1) = 0
983  IF (jbeg==jpnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,2) = 0
984  IF (jend==jpnend .AND. kend==kpnend) grid%nghbor(3,1:6,3) = 0
985  IF (jend==jpnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,4) = 0
986  ELSEIF (lbound==2) THEN
987  IF (jbeg==jpnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,5) = 0
988  IF (jbeg==jpnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,6) = 0
989  IF (jend==jpnend .AND. kend==kpnend) grid%nghbor(3,1:6,7) = 0
990  IF (jend==jpnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,8) = 0
991  ELSEIF (lbound==3) THEN
992  IF (ibeg==ipnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,1) = 0
993  IF (ibeg==ipnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,2) = 0
994  IF (iend==ipnend .AND. kend==kpnend) grid%nghbor(3,1:6,6) = 0
995  IF (iend==ipnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,5) = 0
996  ELSEIF (lbound==4) THEN
997  IF (ibeg==ipnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,4) = 0
998  IF (ibeg==ipnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,3) = 0
999  IF (iend==ipnend .AND. kend==kpnend) grid%nghbor(3,1:6,7) = 0
1000  IF (iend==ipnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,8) = 0
1001  ELSEIF (lbound==5) THEN
1002  IF (ibeg==ipnbeg .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,1) = 0
1003  IF (ibeg==ipnbeg .AND. jend==jpnend) grid%nghbor(3,1:6,4) = 0
1004  IF (iend==ipnend .AND. jend==jpnend) grid%nghbor(3,1:6,8) = 0
1005  IF (iend==ipnend .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,5) = 0
1006  ELSEIF (lbound==6) THEN
1007  IF (ibeg==ipnbeg .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,2) = 0
1008  IF (ibeg==ipnbeg .AND. jend==jpnend) grid%nghbor(3,1:6,3) = 0
1009  IF (iend==ipnend .AND. jend==jpnend) grid%nghbor(3,1:6,7) = 0
1010  IF (iend==ipnend .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,6) = 0
1011  ENDIF ! lbound
1012  ENDIF ! bc_external
1013  ENDDO ! iPatch
1014 
1015  DO ipatch=1,regions(ireg)%nPatches
1016  patch => regions(ireg)%levels(ilev)%patches(ipatch)
1017  lbound = patch%lbound
1018  bctype = patch%bcType
1019 
1020  CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
1021  ibeg,iend,jbeg,jend,kbeg,kend )
1022 
1023  IF ((bctype>=bc_inflow .AND. bctype<=bc_inflow +bc_range) .OR. &
1024  (bctype>=bc_outflow .AND. bctype<=bc_outflow +bc_range) .OR. &
1025  (bctype>=bc_slipwall .AND. bctype<=bc_slipwall +bc_range) .OR. &
1026  (bctype>=bc_noslipwall .AND. bctype<=bc_noslipwall+bc_range) .OR. &
1027  (bctype>=bc_farfield .AND. bctype<=bc_farfield +bc_range) .OR. &
1028  (bctype>=bc_injection .AND. bctype<=bc_injection +bc_range) .OR. &
1029  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
1030  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range)) THEN
1031  IF (lbound==1) THEN
1032  IF (jbeg==jpnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,1) = 2
1033  IF (jbeg==jpnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,2) = 2
1034  IF (jend==jpnend .AND. kend==kpnend) grid%nghbor(3,1:6,3) = 2
1035  IF (jend==jpnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,4) = 2
1036  ELSEIF (lbound==2) THEN
1037  IF (jbeg==jpnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,5) = 2
1038  IF (jbeg==jpnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,6) = 2
1039  IF (jend==jpnend .AND. kend==kpnend) grid%nghbor(3,1:6,7) = 2
1040  IF (jend==jpnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,8) = 2
1041  ELSEIF (lbound==3) THEN
1042  IF (ibeg==ipnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,1) = 2
1043  IF (ibeg==ipnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,2) = 2
1044  IF (iend==ipnend .AND. kend==kpnend) grid%nghbor(3,1:6,6) = 2
1045  IF (iend==ipnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,5) = 2
1046  ELSEIF (lbound==4) THEN
1047  IF (ibeg==ipnbeg .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,4) = 2
1048  IF (ibeg==ipnbeg .AND. kend==kpnend) grid%nghbor(3,1:6,3) = 2
1049  IF (iend==ipnend .AND. kend==kpnend) grid%nghbor(3,1:6,7) = 2
1050  IF (iend==ipnend .AND. kbeg==kpnbeg) grid%nghbor(3,1:6,8) = 2
1051  ELSEIF (lbound==5) THEN
1052  IF (ibeg==ipnbeg .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,1) = 2
1053  IF (ibeg==ipnbeg .AND. jend==jpnend) grid%nghbor(3,1:6,4) = 2
1054  IF (iend==ipnend .AND. jend==jpnend) grid%nghbor(3,1:6,8) = 2
1055  IF (iend==ipnend .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,5) = 2
1056  ELSEIF (lbound==6) THEN
1057  IF (ibeg==ipnbeg .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,2) = 2
1058  IF (ibeg==ipnbeg .AND. jend==jpnend) grid%nghbor(3,1:6,3) = 2
1059  IF (iend==ipnend .AND. jend==jpnend) grid%nghbor(3,1:6,7) = 2
1060  IF (iend==ipnend .AND. jbeg==jpnbeg) grid%nghbor(3,1:6,6) = 2
1061  ENDIF ! lbound
1062  ENDIF ! bc_external
1063  ENDDO ! iPatch
1064 
1065 ! DO ic = 1,8
1066 ! DO k=1,6
1067 ! ------- inhibitor
1068 ! IF (iReg==70) &
1069 ! ------- titan4
1070 ! IF (iReg==120) &
1071 ! write(*,*)iReg,ic,k,edgelen,grid%nghbor(1:3,k,ic)
1072 ! ENDDO
1073 ! ENDDO
1074 
1075  ENDIF ! myProcid
1076  ENDDO ! iReg
1077 
1078 ! deallocate temporary arrays -------------------------------------------------
1079 
1080  DEALLOCATE( dist, stat=errfl ); IF (errfl>0) goto 99
1081 
1082  goto 999
1083 
1084 ! finalize --------------------------------------------------------------------
1085 
1086 88 CONTINUE
1087 
1088  global%error = errfl
1089  CALL errorstop( global,err_allocate,__line__ )
1090 
1091 99 CONTINUE
1092 
1093  global%error = errfl
1094  CALL errorstop( global,err_deallocate,__line__ )
1095 
1096 999 CONTINUE
1097 
1098  CALL deregisterfunction( global )
1099 
1100 END SUBROUTINE rflo_mgframesrchneighbors
1101 
1102 
1103 !******************************************************************************
1104 !
1105 ! Purpose: correct six closest neighbors
1106 !
1107 ! Description: none.
1108 !
1109 ! Input: regions = data of current region.
1110 !
1111 ! Output: grid%nghbor = corrected neighbouring points identified
1112 !
1113 ! Notes: none
1114 !
1115 !******************************************************************************
1116 
1117 SUBROUTINE rflo_mgframecorrectneighbors( regions )
1118 
1120 
1121  IMPLICIT NONE
1122 
1123 ! ... parameters
1124  TYPE(t_region), POINTER :: regions(:)
1125 
1126 ! ... loop variables
1127  INTEGER :: i, j, k, ic, ireg, nc, nreg, lc, lreg
1128 
1129 ! ... local variables
1130  INTEGER :: ilev, bctype, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
1131  INTEGER :: ijknode(4), inoff, ijnoff, errfl
1132  REAL(RFREAL) :: edgelen, ds, du2, dumax
1133  REAL(RFREAL), POINTER :: xyz(:,:)
1134  REAL(RFREAL), ALLOCATABLE :: dist(:,:)
1135 
1136  TYPE(t_patch), POINTER :: patch
1137  TYPE(t_grid), POINTER :: grid
1138  TYPE(t_global), POINTER :: global
1139 
1140 !******************************************************************************
1141 
1142  global => regions(1)%global
1143 
1144  CALL registerfunction( global,'RFLO_MgFrameCorrectNeighbors',&
1145  'RFLO_ModMoveGridConform.F90' )
1146 
1147 ! search for six closest neighbours -------------------------------------------
1148 
1149  ALLOCATE( dist(8,global%nRegions), stat=errfl ); IF (errfl>0) goto 88
1150 
1151  ilev = 1
1152 
1153  DO ireg = 1,global%nRegions
1154  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1155  regions(ireg)%active==active) THEN ! on my processor
1156 
1157  grid => regions(ireg)%levels(ilev)%grid
1158 
1159  CALL rflo_getdimensphys( regions(ireg),ilev,ipcbeg,ipcend, &
1160  jpcbeg,jpcend,kpcbeg,kpcend )
1161  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
1162 
1163  xyz => regions(ireg)%levels(ilev)%gridOld%xyz
1164 
1165 ! --- calculate the shortest cell edge
1166 
1167  edgelen = 1.e+30_rfreal
1168 
1169  DO k=kpcbeg,kpcend
1170  DO j=jpcbeg,jpcend
1171  DO i=ipcbeg,ipcend
1172  ijknode(1) = indijk(i ,j ,k ,inoff,ijnoff)
1173  ijknode(2) = indijk(i+1,j ,k ,inoff,ijnoff)
1174  ijknode(3) = indijk(i ,j+1,k ,inoff,ijnoff)
1175  ijknode(4) = indijk(i ,j ,k+1,inoff,ijnoff)
1176  ds = sqrt((xyz(xcoord,ijknode(2))-xyz(xcoord,ijknode(1)))**2+ &
1177  (xyz(ycoord,ijknode(2))-xyz(ycoord,ijknode(1)))**2+ &
1178  (xyz(zcoord,ijknode(2))-xyz(zcoord,ijknode(1)))**2)
1179  edgelen = min(edgelen,ds)
1180  ds = sqrt((xyz(xcoord,ijknode(3))-xyz(xcoord,ijknode(1)))**2+ &
1181  (xyz(ycoord,ijknode(3))-xyz(ycoord,ijknode(1)))**2+ &
1182  (xyz(zcoord,ijknode(3))-xyz(zcoord,ijknode(1)))**2)
1183  edgelen = min(edgelen,ds)
1184  ds = sqrt((xyz(xcoord,ijknode(4))-xyz(xcoord,ijknode(1)))**2+ &
1185  (xyz(ycoord,ijknode(4))-xyz(ycoord,ijknode(1)))**2+ &
1186  (xyz(zcoord,ijknode(4))-xyz(zcoord,ijknode(1)))**2)
1187  edgelen = min(edgelen,ds)
1188  ENDDO
1189  ENDDO
1190  ENDDO
1191 
1192  DO ic = 1,8
1193  DO k = 1,6
1194  nc = grid%nghbor(1,k,ic)
1195  nreg = grid%nghbor(2,k,ic)
1196  dumax = -1.e+20_rfreal
1197 
1198  DO lreg = 1,global%nRegions
1199  DO lc = 1,8
1200  dist(lc,lreg) = sqrt((grid%regCornOrig(xcoord,nc,nreg)- &
1201  grid%regCornOrig(xcoord,lc,lreg))**2 + &
1202  (grid%regCornOrig(ycoord,nc,nreg)- &
1203  grid%regCornOrig(ycoord,lc,lreg))**2 + &
1204  (grid%regCornOrig(zcoord,nc,nreg)- &
1205  grid%regCornOrig(zcoord,lc,lreg))**2)
1206 
1207  IF (dist(lc,lreg) < 0.1_rfreal*edgelen) THEN
1208  du2 = grid%regCornOld(xcoord,lc,lreg)**2 + &
1209  grid%regCornOld(ycoord,lc,lreg)**2 + &
1210  grid%regCornOld(zcoord,lc,lreg)**2
1211 
1212  IF ( du2 > dumax ) THEN
1213  dumax = du2
1214  grid%nghbor(1,k,ic) = lc
1215  grid%nghbor(2,k,ic) = lreg
1216  ENDIF ! duMax
1217  ENDIF ! dist
1218  ENDDO ! lc
1219  ENDDO ! lReg
1220  ENDDO ! k
1221  ENDDO ! ic
1222 
1223  ENDIF ! myProcid
1224  ENDDO ! iReg
1225 
1226 ! deallocate temporary arrays -------------------------------------------------
1227 
1228  DEALLOCATE( dist, stat=errfl ); IF (errfl>0) goto 99
1229 
1230  goto 999
1231 
1232 ! finalize --------------------------------------------------------------------
1233 
1234 88 CONTINUE
1235 
1236  global%error = errfl
1237  CALL errorstop( global,err_allocate,__line__ )
1238 
1239 99 CONTINUE
1240 
1241  global%error = errfl
1242  CALL errorstop( global,err_deallocate,__line__ )
1243 
1244 999 CONTINUE
1245 
1246  CALL deregisterfunction( global )
1247 
1248 END SUBROUTINE rflo_mgframecorrectneighbors
1249 
1250 !******************************************************************************
1251 !
1252 ! Purpose: move block corners by averaging over 6 closest neighbours
1253 !
1254 ! Description: none.
1255 !
1256 ! Input: regions = data of current region.
1257 !
1258 ! Output: region%levels%grid%regCorn = new block corners movement.
1259 !
1260 ! Notes: none
1261 !
1262 !******************************************************************************
1263 
1264 SUBROUTINE rflo_mgframemovecorners( regions )
1265 
1267  USE modtools, ONLY : isnan
1268  IMPLICIT NONE
1269 
1270 #include "Indexing.h"
1271 
1272 ! ... parameters
1273  TYPE(t_region), POINTER :: regions(:)
1274 
1275 ! ... loop variables
1276  INTEGER :: ireg, ico, k
1277 
1278 ! ... local variables
1279  INTEGER :: ilev, interior, nco(6), nreg(6), ic(8)
1280  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, inoff, ijnoff
1281  REAL(RFREAL) :: rdenom, amp(3), pow, dist(6), wght(6)
1282 
1283  TYPE(t_grid), POINTER :: grid
1284  TYPE(t_global), POINTER :: global
1285 
1286 !******************************************************************************
1287 
1288  global => regions(1)%global
1289 
1290  CALL registerfunction( global,'RFLO_MgFrameMoveCorners',&
1291  'RFLO_ModMoveGridConform.F90' )
1292 
1293 ! move block corners ----------------------------------------------------------
1294 
1295  ilev = 1
1296  amp(1) = global%moveGridAmplifX
1297  amp(2) = global%moveGridAmplifY
1298  amp(3) = global%moveGridAmplifZ
1299  pow = global%moveGridPower
1300 
1301  DO ireg = 1,global%nRegions
1302  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1303  regions(ireg)%active==active) THEN ! on my processor
1304 
1305  grid => regions(ireg)%levels(ilev)%grid
1306 
1307  DO ico = 1,8
1308  nco(1:6) = grid%nghbor(1,1:6,ico)
1309  nreg(1:6) = grid%nghbor(2,1:6,ico)
1310  interior = grid%nghbor(3,1 ,ico)
1311 
1312  IF (interior==1) THEN
1313  DO k = 1,6
1314  dist(k) = (grid%regCornOrig(xcoord,nco(k),nreg(k)) - &
1315  grid%regCornOrig(xcoord,ico,ireg))**2 + &
1316  (grid%regCornOrig(ycoord,nco(k),nreg(k)) - &
1317  grid%regCornOrig(ycoord,ico,ireg))**2 + &
1318  (grid%regCornOrig(zcoord,nco(k),nreg(k)) - &
1319  grid%regCornOrig(zcoord,ico,ireg))**2
1320  dist(k) = 1._rfreal/sqrt( dist(k) )**pow
1321  ENDDO
1322  rdenom = 1._rfreal/(dist(1)+dist(2)+dist(3)+dist(4)+dist(5)+dist(6))
1323 
1324  DO k = 1,6
1325  wght(k) = dist(k)*rdenom
1326 ! write(*,*)iReg,ico,k,nReg(k),nco(k),dist(k),wght(k)
1327  IF (isnan(wght(k))) &
1328  CALL errorstop( global,err_illegal_value,__line__, &
1329  'invalid weights for global frame motion')
1330  ENDDO
1331 
1332  grid%regCorn(xcoord,ico,ireg) = &
1333  (wght(1)*grid%regCornOld(xcoord,nco(1),nreg(1)) + &
1334  wght(2)*grid%regCornOld(xcoord,nco(2),nreg(2)) + &
1335  wght(3)*grid%regCornOld(xcoord,nco(3),nreg(3)) + &
1336  wght(4)*grid%regCornOld(xcoord,nco(4),nreg(4)) + &
1337  wght(5)*grid%regCornOld(xcoord,nco(5),nreg(5)) + &
1338  wght(6)*grid%regCornOld(xcoord,nco(6),nreg(6)))
1339 
1340  grid%regCorn(ycoord,ico,ireg) = &
1341  (wght(1)*grid%regCornOld(ycoord,nco(1),nreg(1)) + &
1342  wght(2)*grid%regCornOld(ycoord,nco(2),nreg(2)) + &
1343  wght(3)*grid%regCornOld(ycoord,nco(3),nreg(3)) + &
1344  wght(4)*grid%regCornOld(ycoord,nco(4),nreg(4)) + &
1345  wght(5)*grid%regCornOld(ycoord,nco(5),nreg(5)) + &
1346  wght(6)*grid%regCornOld(ycoord,nco(6),nreg(6)))
1347 
1348  grid%regCorn(zcoord,ico,ireg) = &
1349  (wght(1)*grid%regCornOld(zcoord,nco(1),nreg(1)) + &
1350  wght(2)*grid%regCornOld(zcoord,nco(2),nreg(2)) + &
1351  wght(3)*grid%regCornOld(zcoord,nco(3),nreg(3)) + &
1352  wght(4)*grid%regCornOld(zcoord,nco(4),nreg(4)) + &
1353  wght(5)*grid%regCornOld(zcoord,nco(5),nreg(5)) + &
1354  wght(6)*grid%regCornOld(zcoord,nco(6),nreg(6)))
1355  ENDIF ! interior
1356  ENDDO ! ico
1357  ENDIF ! myProcid
1358  ENDDO ! iReg
1359 
1360  DO ireg = 1,global%nRegions
1361  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1362  regions(ireg)%active==active) THEN ! on my processor
1363 
1364  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
1365  jpnbeg,jpnend,kpnbeg,kpnend )
1366  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
1367 
1368  grid => regions(ireg)%levels(ilev)%grid
1369 
1370  ic(1) = indijk(ipnbeg ,jpnbeg ,kpnbeg ,inoff,ijnoff)
1371  ic(2) = indijk(ipnbeg ,jpnbeg ,kpnend ,inoff,ijnoff)
1372  ic(3) = indijk(ipnbeg ,jpnend ,kpnend ,inoff,ijnoff)
1373  ic(4) = indijk(ipnbeg ,jpnend ,kpnbeg ,inoff,ijnoff)
1374  ic(5) = indijk(ipnend ,jpnbeg ,kpnbeg ,inoff,ijnoff)
1375  ic(6) = indijk(ipnend ,jpnbeg ,kpnend ,inoff,ijnoff)
1376  ic(7) = indijk(ipnend ,jpnend ,kpnend ,inoff,ijnoff)
1377  ic(8) = indijk(ipnend ,jpnend ,kpnbeg ,inoff,ijnoff)
1378 
1379  DO ico = 1,8
1380  interior = grid%nghbor(3, 1, ico)
1381  IF (interior==1) THEN
1382  grid%regCornOld(xcoord,ico,ireg)=amp(1)*grid%regCorn(xcoord,ico,ireg)
1383  grid%regCornOld(ycoord,ico,ireg)=amp(2)*grid%regCorn(ycoord,ico,ireg)
1384  grid%regCornOld(zcoord,ico,ireg)=amp(3)*grid%regCorn(zcoord,ico,ireg)
1385 
1386  grid%xyz(xcoord,ic(ico)) = grid%regCorn(xcoord,ico,ireg)
1387  grid%xyz(ycoord,ic(ico)) = grid%regCorn(ycoord,ico,ireg)
1388  grid%xyz(zcoord,ic(ico)) = grid%regCorn(zcoord,ico,ireg)
1389  ENDIF
1390  ENDDO ! ic
1391  ENDIF ! myProcid
1392  ENDDO ! iReg
1393 
1394 ! finalize --------------------------------------------------------------------
1395 
1396  CALL deregisterfunction( global )
1397 
1398 END SUBROUTINE rflo_mgframemovecorners
1399 
1400 
1401 !******************************************************************************
1402 !
1403 ! Purpose: receive and distribute the deformations of surfaces
1404 ! in block-wise manner.
1405 !
1406 ! Description: none.
1407 !
1408 ! Input: regions = data of all grid regions.
1409 !
1410 ! Output: regions%levels%grid%xyz = deformations at the boundaries
1411 ! someMoved = parts of grid moved.
1412 !
1413 ! Notes: grid%xyz temporarily stores nodal displacements. The deformation
1414 ! is applied to the finest grid first.
1415 !
1416 !******************************************************************************
1417 
1418 SUBROUTINE rflo_mgframesurfaces( regions,someMoved,iType )
1419 
1423  IMPLICIT NONE
1424 
1425 ! ... parameters
1426  LOGICAL :: somemoved
1427  INTEGER :: itype
1428 
1429  TYPE(t_region), POINTER :: regions(:)
1430 
1431 ! ... loop variables
1432  INTEGER :: ireg, iter, ipatch, i, j, k, ijkn
1433 
1434 ! ... local variables
1435  INTEGER :: ilev, bctype
1436  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, inoff, ijnoff
1437  TYPE(t_grid), POINTER :: grid, gridold
1438  TYPE(t_global), POINTER :: global
1439  TYPE(t_patch), POINTER :: patch
1440 
1441 !******************************************************************************
1442 
1443  global => regions(1)%global
1444 
1445  CALL registerfunction( global,'RFLO_MgFrameSurfaces',&
1446  'RFLO_ModMoveGridConform.F90' )
1447 
1448 ! move grid separately for each region ----------------------------------------
1449 
1450  somemoved = .false.
1451  ilev = 1
1452 
1453  DO ireg=1,global%nRegions
1454  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1455  regions(ireg)%active==active .AND. & ! on my processor
1456  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1457 
1458  grid => regions(ireg)%levels(ilev)%grid
1459  gridold => regions(ireg)%levels(ilev)%gridOld
1460  somemoved = .true.
1461 
1462 ! --- store the old grid
1463 
1464  gridold%indSvel = grid%indSvel
1465  gridold%ipc = grid%ipc
1466  gridold%jpc = grid%jpc
1467  gridold%kpc = grid%kpc
1468  gridold%xyz(:,:) = grid%xyz(:,:)
1469  gridold%si(:,:) = grid%si(:,:)
1470  gridold%sj(:,:) = grid%sj(:,:)
1471  gridold%sk(:,:) = grid%sk(:,:)
1472  gridold%vol(:) = grid%vol(:)
1473 
1474 ! --- calculate arclengths between boundaries
1475 
1476  CALL rflo_arclengthbounds( regions(ireg),gridold%xyzOld, &
1477  grid%arcLen12,grid%arcLen34,grid%arcLen56 )
1478 
1479 ! --- get the boundary deformations
1480 
1481  CALL rflo_getdeformation( regions(ireg),grid%boundMoved,grid%xyz )
1482 
1483  grid%xyzOld(:,:) = grid%xyz(:,:)
1484 
1485  ENDIF ! region on this processor and active, grid moving
1486  ENDDO ! iReg
1487 
1488 ! broadcast and compute block corners deformation
1489 
1490  iter = 1
1491  CALL rflo_mgframebroadcast( regions,1,iter )
1492  CALL rflo_mgframecorrectneighbors( regions )
1493  CALL rflo_mgframemovecorners( regions )
1494 
1495  DO iter = 2,10
1496  CALL rflo_mgframebroadcast( regions,1,iter )
1497  CALL rflo_mgframemovecorners( regions )
1498  ENDDO
1499 
1500  DO ireg=1,global%nRegions
1501  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1502  regions(ireg)%active==active .AND. & ! on my processor
1503  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1504 
1505  grid => regions(ireg)%levels(ilev)%grid
1506  gridold => regions(ireg)%levels(ilev)%gridOld
1507 
1508 ! --- calculate deformations at remaining edges
1509 
1510  CALL rflo_mgframeedges( regions(ireg),itype,grid%boundMoved, &
1511  grid%allExternal,grid%edgeMoved,grid%arcLen12, &
1512  grid%arcLen34,grid%arcLen56,gridold%xyzOld,grid%xyz )
1513 
1514 ! --- calculate deformations at remaining boundaries
1515 
1516  IF (itype==1) THEN
1517  CALL rflo_mgframebnddeformation( regions(ireg),grid%boundMoved, &
1518  grid%edgeMoved,grid%arcLen12, &
1519  grid%arcLen34,grid%arcLen56, &
1520  gridold%xyzOld,grid%xyz )
1521  CALL rflo_mgframerestoreexternal( regions(ireg) )
1522 
1523  ELSE ! iType
1524  CALL rflo_boundarydeformation( regions(ireg),grid%boundMoved, &
1525  grid%edgeMoved,grid%arcLen12, &
1526  grid%arcLen34,grid%arcLen56, &
1527  gridold%xyzOld,grid%xyz )
1528  CALL rflo_mgframerestoreexternal( regions(ireg) )
1529  ENDIF ! iType
1530 
1531  ENDIF ! region on this processor and active, grid moving
1532  ENDDO ! iReg
1533 
1534 ! finalize --------------------------------------------------------------------
1535 
1536  CALL deregisterfunction( global )
1537 
1538 END SUBROUTINE rflo_mgframesurfaces
1539 
1540 
1541 !******************************************************************************
1542 !
1543 ! Purpose: restore deformation of solid surfaces from genx at given patches.
1544 !
1545 ! Description: none.
1546 !
1547 ! Input: region = data of current region.
1548 !
1549 ! Output: regions%levels%grid%xyz = deformations at the boundaries restored
1550 !
1551 ! Notes: grid%xyz temporarily stores nodal displacements. The 'untouched'
1552 ! deformation from genx has been saved in grid%xyzOld.
1553 !
1554 !******************************************************************************
1555 
1556 SUBROUTINE rflo_mgframerestoreexternal( region )
1557 
1559  IMPLICIT NONE
1560 
1561 ! ... parameters
1562  TYPE(t_region) :: region
1563 
1564 ! ... loop variables
1565  INTEGER :: ireg, ipatch, i, j, k
1566 
1567 ! ... local variables
1568  INTEGER :: ilev, ijkn, lbound
1569  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, inoff, ijnoff
1570  TYPE(t_grid), POINTER :: grid
1571  TYPE(t_global), POINTER :: global
1572  TYPE(t_patch), POINTER :: patch
1573 
1574 !******************************************************************************
1575 
1576  global => region%global
1577 
1578  CALL registerfunction( global,'RFLO_MgFrameRestoreExternal',&
1579  'RFLO_ModMoveGridConform.F90' )
1580 
1581 ! parameters and pointers -----------------------------------------------------
1582 
1583  ilev = 1
1584  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
1585 
1586  grid => region%levels(ilev)%grid
1587 
1588 ! restore displacements
1589 
1590  DO ipatch=1,region%nPatches
1591  patch => region%levels(ilev)%patches(ipatch)
1592  lbound = patch%lbound
1593 
1594  IF (patch%bcMotion == bc_external .AND. &
1595  (grid%allExternal(lbound).EQV..false.)) THEN
1596  CALL rflo_getpatchindicesnodes( region,patch,ilev, &
1597  ibeg,iend,jbeg,jend,kbeg,kend )
1598 
1599  DO k=kbeg,kend
1600  DO j=jbeg,jend
1601  DO i=ibeg,iend
1602  ijkn = indijk(i,j,k,inoff,ijnoff)
1603  grid%xyz(xcoord,ijkn) = grid%xyzOld(xcoord,ijkn)
1604  grid%xyz(ycoord,ijkn) = grid%xyzOld(ycoord,ijkn)
1605  grid%xyz(zcoord,ijkn) = grid%xyzOld(zcoord,ijkn)
1606  ENDDO
1607  ENDDO
1608  ENDDO
1609 
1610  ENDIF ! external BC
1611  ENDDO ! iPatch
1612 
1613 ! finalize --------------------------------------------------------------------
1614 
1615  CALL deregisterfunction( global )
1616 
1617 END SUBROUTINE rflo_mgframerestoreexternal
1618 
1619 !******************************************************************************
1620 !
1621 ! Purpose: calculate node displacements on those edges whose end points have
1622 ! moved, but the associated boundaries were not updated yet (finest
1623 ! grid only).
1624 !
1625 ! Description: points along an edge are shifted using 1-D linear transfinite
1626 ! interpolation (TFI).
1627 !
1628 ! Input: region = grid dimensions
1629 ! boundMoved = flag for boundaries of a region which have moved
1630 ! arcLen12 = arclength between i=const. boundaries for each j, k
1631 ! arcLen34 = arclength between j=const. boundaries for each k, i
1632 ! arcLen56 = arclength between k=const. boundaries for each i, j
1633 ! xyzOld = grid from previous time step.
1634 !
1635 ! Output: edgeMoved = flag if discretization at an edge was changed
1636 ! dNode = updated deformations at edges.
1637 !
1638 ! Notes: variable dNode contains the whole 3-D field.
1639 !
1640 !******************************************************************************
1641 
1642 SUBROUTINE rflo_mgframeedges( region,iType,boundMoved,allExternal,edgeMoved, &
1643  arclen12,arclen34,arclen56,xyzold,dnode )
1644 
1646  rflo_tfint1d
1647  IMPLICIT NONE
1648 
1649 #include "Indexing.h"
1650 
1651 ! ... parameters
1652  LOGICAL :: boundmoved(6), allexternal(6), edgemoved(12)
1653 
1654  INTEGER :: itype
1655  REAL(RFREAL), POINTER :: arclen12(:,:), arclen34(:,:), arclen56(:,:)
1656  REAL(RFREAL), POINTER :: dnode(:,:), xyzold(:,:)
1657 
1658  TYPE(t_region) :: region
1659 
1660 ! ... loop variables
1661  INTEGER :: iedge, ind
1662 
1663 ! ... local variables
1664  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, l1c, l2c
1665  INTEGER :: indbeg, indend, ijkn, ijkn1, ijknbeg, ijknend, inoff, ijnoff
1666  INTEGER :: switch(12,11), intertype, iedgeglo
1667 
1668  REAL(RFREAL) :: arclen, ds, s, dn(3), dnbeg(3), dnend(3)
1669  LOGICAL :: interact
1670 
1671 !******************************************************************************
1672 
1673  CALL registerfunction( region%global,'RFLO_MgFrameEdges',&
1674  'RFLO_ModMoveGridConform.F90' )
1675 
1676 ! get dimensions --------------------------------------------------------------
1677 
1678  ilev = 1
1679  CALL rflo_getdimensphysnodes( region,ilev,ipnbeg,ipnend, &
1680  jpnbeg,jpnend,kpnbeg,kpnend )
1681  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
1682 
1683 ! set edge switch -------------------------------------------------------------
1684 ! switch(:,1) = begins at boundary
1685 ! switch(:,2) = ends on boundary
1686 ! switch(:,3) = right boundary
1687 ! switch(:,4) = left boundary
1688 ! switch(:,5) = direction (from-to boundary)
1689 ! switch(:,6) = start index
1690 ! switch(:,7) = end index
1691 ! switch(:,8) = constant index in 1st direction
1692 ! switch(:,9) = constant index in 2nd direction
1693 ! switch(:,10) = start corner number
1694 ! switch(:,11) = end corner number
1695 
1696  switch( 1,:) = (/5, 6, 1, 3, 56, kpnbeg, kpnend, ipnbeg, jpnbeg, 1, 2/)
1697  switch( 2,:) = (/3, 4, 1, 6, 34, jpnbeg, jpnend, kpnend, ipnbeg, 2, 3/)
1698  switch( 3,:) = (/5, 6, 1, 4, 56, kpnbeg, kpnend, ipnbeg, jpnend, 4, 3/)
1699  switch( 4,:) = (/3, 4, 1, 5, 34, jpnbeg, jpnend, kpnbeg, ipnbeg, 1, 4/)
1700  switch( 5,:) = (/5, 6, 2, 3, 56, kpnbeg, kpnend, ipnend, jpnbeg, 5, 6/)
1701  switch( 6,:) = (/3, 4, 2, 6, 34, jpnbeg, jpnend, kpnend, ipnend, 6, 7/)
1702  switch( 7,:) = (/5, 6, 2, 4, 56, kpnbeg, kpnend, ipnend, jpnend, 8, 7/)
1703  switch( 8,:) = (/3, 4, 2, 5, 34, jpnbeg, jpnend, kpnbeg, ipnend, 5, 8/)
1704  switch( 9,:) = (/1, 2, 3, 5, 12, ipnbeg, ipnend, jpnbeg, kpnbeg, 1, 5/)
1705  switch(10,:) = (/1, 2, 3, 6, 12, ipnbeg, ipnend, jpnbeg, kpnend, 2, 6/)
1706  switch(11,:) = (/1, 2, 4, 5, 12, ipnbeg, ipnend, jpnend, kpnbeg, 4, 8/)
1707  switch(12,:) = (/1, 2, 4, 6, 12, ipnbeg, ipnend, jpnend, kpnend, 3, 7/)
1708 
1709 ! edge movement flag ----------------------------------------------------------
1710 
1711  edgemoved(:) = .false.
1712 
1713  IF (itype/=1) THEN
1714  IF (boundmoved(1) .AND. allexternal(1)) THEN
1715  edgemoved( 1) = .true.; edgemoved( 2) = .true.
1716  edgemoved( 3) = .true.; edgemoved( 4) = .true.
1717  ENDIF
1718  IF (boundmoved(2) .AND. allexternal(2)) THEN
1719  edgemoved( 5) = .true.; edgemoved( 6) = .true.
1720  edgemoved( 7) = .true.; edgemoved( 8) = .true.
1721  ENDIF
1722  IF (boundmoved(3) .AND. allexternal(3)) THEN
1723  edgemoved( 1) = .true.; edgemoved( 5) = .true.
1724  edgemoved( 9) = .true.; edgemoved(10) = .true.
1725  ENDIF
1726  IF (boundmoved(4) .AND. allexternal(4)) THEN
1727  edgemoved( 3) = .true.; edgemoved( 7) = .true.
1728  edgemoved(11) = .true.; edgemoved(12) = .true.
1729  ENDIF
1730  IF (boundmoved(5) .AND. allexternal(5)) THEN
1731  edgemoved( 4) = .true.; edgemoved( 8) = .true.
1732  edgemoved( 9) = .true.; edgemoved(11) = .true.
1733  ENDIF
1734  IF (boundmoved(6) .AND. allexternal(6)) THEN
1735  edgemoved( 2) = .true.; edgemoved( 6) = .true.
1736  edgemoved(10) = .true.; edgemoved(12) = .true.
1737  ENDIF
1738  ENDIF ! iType
1739 
1740 ! loop over all 12 edges ------------------------------------------------------
1741 
1742  DO iedge=1,12
1743  IF (.NOT.edgemoved(iedge)) THEN
1744 
1745  edgemoved(iedge) = .true.
1746 
1747  ds = 0._rfreal
1748  indbeg = switch(iedge,6)
1749  indend = switch(iedge,7)
1750  l1c = switch(iedge,8)
1751  l2c = switch(iedge,9)
1752 
1753  iedgeglo = iedge
1754  IF (iedge==11) iedgeglo=12
1755  IF (iedge==12) iedgeglo=11
1756  interact = region%levels(ilev)%edgeCells(iedgeglo)%interact
1757  intertype = region%levels(ilev)%edgeCells(iedgeglo)%interType
1758 
1759  IF (((region%levels(ilev)%grid%nghbor(3,1,switch(iedge,10))==1 .OR. &
1760  region%levels(ilev)%grid%nghbor(3,1,switch(iedge,11))==1) .AND. &
1761  ((interact .EQV. .true.) .AND. (intertype==edge_interact_full))) &
1762  .OR. &
1763  region%levels(ilev)%grid%nghbor(3,1,switch(iedge,10))==2 .OR. &
1764  region%levels(ilev)%grid%nghbor(3,1,switch(iedge,11))==2) THEN
1765 
1766  DO ind=indbeg+1,indend-1
1767  IF (switch(iedge,5) == 12) THEN
1768  ijkn = indijk(ind ,l1c,l2c,inoff,ijnoff)
1769  ijkn1 = indijk(ind-1 ,l1c,l2c,inoff,ijnoff)
1770  ijknbeg = indijk(indbeg,l1c,l2c,inoff,ijnoff)
1771  ijknend = indijk(indend,l1c,l2c,inoff,ijnoff)
1772  arclen = arclen12(l1c,l2c)
1773  dnbeg(:) = dnode(:,ijknbeg)
1774  dnend(:) = dnode(:,ijknend)
1775  ELSE IF (switch(iedge,5) == 34) THEN
1776  ijkn = indijk(l2c,ind ,l1c,inoff,ijnoff)
1777  ijkn1 = indijk(l2c,ind-1 ,l1c,inoff,ijnoff)
1778  ijknbeg = indijk(l2c,indbeg,l1c,inoff,ijnoff)
1779  ijknend = indijk(l2c,indend,l1c,inoff,ijnoff)
1780  arclen = arclen34(l1c,l2c)
1781  dnbeg(:) = dnode(:,ijknbeg)
1782  dnend(:) = dnode(:,ijknend)
1783  ELSE IF (switch(iedge,5) == 56) THEN
1784  ijkn = indijk(l1c,l2c,ind ,inoff,ijnoff)
1785  ijkn1 = indijk(l1c,l2c,ind-1 ,inoff,ijnoff)
1786  ijknbeg = indijk(l1c,l2c,indbeg,inoff,ijnoff)
1787  ijknend = indijk(l1c,l2c,indend,inoff,ijnoff)
1788  arclen = arclen56(l1c,l2c)
1789  dnbeg(:) = dnode(:,ijknbeg)
1790  dnend(:) = dnode(:,ijknend)
1791  ENDIF
1792  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
1793  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
1794  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
1795  s = ds/arclen
1796 
1797  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
1798  dnode(:,ijkn) = dn(:)
1799  ENDDO ! i
1800  ENDIF ! nghbor
1801  ENDIF ! edgeMoved
1802  ENDDO ! iEdge
1803 
1804 ! finalize --------------------------------------------------------------------
1805 
1806  CALL deregisterfunction( region%global )
1807 
1808 END SUBROUTINE rflo_mgframeedges
1809 
1810 !******************************************************************************
1811 !
1812 ! Purpose: exchange deformations between the regions as to ensure
1813 ! matching grid nodes at the interfaces.
1814 !
1815 ! Description: none.
1816 !
1817 ! Input: regions = data of all grid regions, deformations.
1818 !
1819 ! Output: regions%levels%grid%xyz = deformations at the boundaries.
1820 !
1821 ! Notes: grid%xyz temporarily stores nodal displacements. The deformation
1822 ! is applied to the finest grid first.
1823 !
1824 !******************************************************************************
1825 
1826 SUBROUTINE rflo_mgframeinterfaces( regions,iType )
1827 
1831  IMPLICIT NONE
1832 
1833 ! ... parameters
1834  TYPE(t_region), POINTER :: regions(:)
1835  INTEGER ::itype
1836 
1837 ! ... loop variables
1838  INTEGER :: ireg, ipatch, ipass
1839 
1840 ! ... local variables
1841  INTEGER :: bctype, iregsrc, ipatchsrc, npass
1842 
1843  TYPE(t_grid), POINTER :: grid, gridold, gridsrc
1844  TYPE(t_global), POINTER :: global
1845  TYPE(t_patch), POINTER :: patch, patchsrc
1846 
1847 !******************************************************************************
1848 
1849  global => regions(1)%global
1850 
1851  CALL registerfunction( global,'RFLO_MgFrameInterfaces',&
1852  'RFLO_ModMoveGridConform.F90' )
1853 
1854 ! fix interfaces between regions ----------------------------------------------
1855 
1856  npass = global%moveGridNsmatch
1857  DO ipass=1,npass
1858 
1859 ! - copy / send deformations
1860 
1861  DO ireg=1,global%nRegions
1862  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1863  regions(ireg)%active==active .AND. & ! on my processor
1864  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1865 
1866  grid => regions(ireg)%levels(1)%grid
1867  gridold => regions(ireg)%levels(1)%gridOld
1868 
1869  DO ipatch=1,regions(ireg)%nPatches
1870  patch => regions(ireg)%levels(1)%patches(ipatch)
1871  bctype = patch%bcType
1872  IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
1873  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
1874  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range)) THEN
1875  iregsrc = patch%srcRegion
1876  ipatchsrc = patch%srcPatch
1877  patchsrc => regions(iregsrc)%levels(1)%patches(ipatchsrc)
1878  gridsrc => regions(iregsrc)%levels(1)%grid
1879 
1880  IF (regions(iregsrc)%procid == global%myProcid) THEN
1881  CALL rflo_exchangednodecopy( regions(ireg),regions(iregsrc), &
1882  patch,patchsrc,.false., &
1883  grid%xyz,gridsrc%xyz )
1884  IF (ipass < npass) THEN
1885  CALL rflo_mgframeedges( regions(ireg),2,grid%boundMoved, &
1886  grid%allExternal,grid%edgeMoved, &
1887  grid%arcLen12,grid%arcLen34, &
1888  grid%arcLen56,gridold%xyzOld,grid%xyz )
1889  CALL rflo_boundarydeformation( regions(ireg),grid%boundMoved, &
1890  grid%edgeMoved,grid%arcLen12, &
1891  grid%arcLen34,grid%arcLen56, &
1892  gridold%xyzOld,grid%xyz )
1893  CALL rflo_mgframerestoreexternal( regions(ireg) )
1894  ENDIF
1895  ELSE
1896  CALL rflo_exchangednodesend( regions(ireg),regions(iregsrc), &
1897  patch,grid%xyz )
1898  ENDIF
1899  ENDIF ! bcType
1900  ENDDO ! iPatch
1901 
1902  ENDIF ! region on this processor and active, grid moving
1903  ENDDO ! iReg
1904 
1905 ! - receive deformations
1906 
1907  DO ireg=1,global%nRegions
1908  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1909  regions(ireg)%active==active .AND. & ! on my processor
1910  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1911 
1912  grid => regions(ireg)%levels(1)%grid
1913  gridold => regions(ireg)%levels(1)%gridOld
1914 
1915  DO ipatch=1,regions(ireg)%nPatches
1916  patch => regions(ireg)%levels(1)%patches(ipatch)
1917  bctype = patch%bcType
1918  IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
1919  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
1920  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range)) THEN
1921  iregsrc = patch%srcRegion
1922  ipatchsrc = patch%srcPatch
1923  patchsrc => regions(iregsrc)%levels(1)%patches(ipatchsrc)
1924  gridsrc => regions(iregsrc)%levels(1)%grid
1925 
1926  IF (regions(iregsrc)%procid /= global%myProcid) THEN
1927  CALL rflo_exchangednoderecv( regions(ireg),regions(iregsrc), &
1928  patch,patchsrc,.false.,grid%xyz )
1929  IF (ipass < npass) THEN
1930  CALL rflo_mgframeedges( regions(ireg),2,grid%boundMoved, &
1931  grid%allExternal,grid%edgeMoved, &
1932  grid%arcLen12,grid%arcLen34, &
1933  grid%arcLen56,gridold%xyzOld,grid%xyz )
1934  CALL rflo_boundarydeformation( regions(ireg),grid%boundMoved, &
1935  grid%edgeMoved,grid%arcLen12, &
1936  grid%arcLen34,grid%arcLen56, &
1937  gridold%xyzOld,grid%xyz )
1938  CALL rflo_mgframerestoreexternal( regions(ireg) )
1939  ENDIF
1940  ENDIF
1941  ENDIF ! bcType
1942  ENDDO ! iPatch
1943 
1944  ENDIF ! region on this processor and active, grid moving
1945  ENDDO ! iReg
1946 
1947 ! - clear send requests
1948 
1949  DO ireg=1,global%nRegions
1950  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1951  regions(ireg)%active==active .AND. & ! on my processor
1952  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1953  CALL rflo_clearsendrequests( regions,ireg,.true. )
1954  ENDIF
1955  ENDDO
1956 
1957  ENDDO ! iPass
1958 
1959 ! finalize --------------------------------------------------------------------
1960 
1961  CALL deregisterfunction( global )
1962 
1963 END SUBROUTINE rflo_mgframeinterfaces
1964 
1965 !******************************************************************************
1966 !
1967 ! Purpose: calculate node displacements on those boundaries whose edges
1968 ! have moved but which were not marked as moving (finest grid only).
1969 !
1970 ! Description: none.
1971 !
1972 ! Input: region = grid dimensions
1973 ! boundMoved = flag for boundaries of a region which have moved
1974 ! edgeMoved = flag for edges whose nodes have moved
1975 ! arcLen12 = arclength between i=const. boundaries for each j, k
1976 ! arcLen34 = arclength between j=const. boundaries for each k, i
1977 ! arcLen56 = arclength between k=const. boundaries for each i, j
1978 ! xyzOld = grid from previous time step.
1979 !
1980 ! Output: dNode = updated deformations at boundaries.
1981 !
1982 ! Notes: variable dNode contains the whole 3-D field.
1983 !
1984 !******************************************************************************
1985 
1986 SUBROUTINE rflo_mgframebnddeformation( region,boundMoved,edgeMoved, &
1987  arclen12,arclen34,arclen56, &
1988  xyzold,dnode )
1989 
1991  rflo_tfint2d
1992  IMPLICIT NONE
1993 
1994 #include "Indexing.h"
1995 
1996 ! ... parameters
1997  LOGICAL :: boundmoved(6), edgemoved(12)
1998 
1999  REAL(RFREAL), POINTER :: arclen12(:,:), arclen34(:,:), arclen56(:,:)
2000  REAL(RFREAL), POINTER :: dnode(:,:), xyzold(:,:)
2001 
2002  TYPE(t_region) :: region
2003 
2004 ! ... loop variables
2005  INTEGER :: ibound, l1, l2
2006 
2007 ! ... local variables
2008  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
2009  INTEGER :: l1b, l1e, l2b, l2e, lc, ijkn, ijke(4), ijkem(4), inoff, ijnoff
2010  INTEGER :: switch(6,9)
2011 
2012  LOGICAL :: sum12
2013 
2014  REAL(RFREAL) :: arclen(4), ds(4), s(4)
2015  REAL(RFREAL) :: corner(3,8), e1(3), e2(3), e3(3), e4(3), &
2016  p1(3), p2(3), p3(3), p4(3), dn(3)
2017 
2018 !******************************************************************************
2019 
2020  CALL registerfunction( region%global,'RFLO_MgFrameBndDeformation',&
2021  'RFLO_ModMoveGridConform.F90' )
2022 
2023 ! get dimensions --------------------------------------------------------------
2024 
2025  ilev = 1
2026  CALL rflo_getdimensphysnodes( region,ilev,ipnbeg,ipnend, &
2027  jpnbeg,jpnend,kpnbeg,kpnend )
2028  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
2029 
2030 ! set boundary switch ---------------------------------------------------------
2031 ! switch(:,1-4) = numbers of the 4 edges of a boundary
2032 ! switch(:,5-6) = first/last index in l1-direction
2033 ! switch(:,7-8) = first/last index in l2-direction
2034 ! switch(:, 9) = constant index
2035 
2036  switch(1,:) = (/ 1, 2, 3, 4, jpnbeg, jpnend, kpnbeg, kpnend, ipnbeg/)
2037  switch(2,:) = (/ 5, 6, 7, 8, jpnbeg, jpnend, kpnbeg, kpnend, ipnend/)
2038  switch(3,:) = (/ 1, 5, 9, 10, kpnbeg, kpnend, ipnbeg, ipnend, jpnbeg/)
2039  switch(4,:) = (/ 3, 7, 11, 12, kpnbeg, kpnend, ipnbeg, ipnend, jpnend/)
2040  switch(5,:) = (/ 4, 8, 9, 11, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg/)
2041  switch(6,:) = (/ 2, 6, 10, 12, ipnbeg, ipnend, jpnbeg, jpnend, kpnend/)
2042 
2043 ! store displacements at corners ----------------------------------------------
2044 
2045  corner(:,1) = dnode(:,indijk(ipnbeg,jpnbeg,kpnbeg,inoff,ijnoff))
2046  corner(:,2) = dnode(:,indijk(ipnbeg,jpnbeg,kpnend,inoff,ijnoff))
2047  corner(:,3) = dnode(:,indijk(ipnbeg,jpnend,kpnend,inoff,ijnoff))
2048  corner(:,4) = dnode(:,indijk(ipnbeg,jpnend,kpnbeg,inoff,ijnoff))
2049  corner(:,5) = dnode(:,indijk(ipnend,jpnbeg,kpnbeg,inoff,ijnoff))
2050  corner(:,6) = dnode(:,indijk(ipnend,jpnbeg,kpnend,inoff,ijnoff))
2051  corner(:,7) = dnode(:,indijk(ipnend,jpnend,kpnend,inoff,ijnoff))
2052  corner(:,8) = dnode(:,indijk(ipnend,jpnend,kpnbeg,inoff,ijnoff))
2053 
2054 ! move nodes on boundaries with active edges ----------------------------------
2055 
2056  DO ibound=1,6
2057 ! IF ((.NOT.boundMoved(iBound)) .AND. &
2058 ! (edgeMoved(switch(iBound,1)) .OR. edgeMoved(switch(iBound,2)) .OR. &
2059 ! edgeMoved(switch(iBound,3)) .OR. edgeMoved(switch(iBound,4)))) THEN
2060 
2061  IF ((edgemoved(switch(ibound,1)) .OR. edgemoved(switch(ibound,2)) .OR. &
2062  edgemoved(switch(ibound,3)) .OR. edgemoved(switch(ibound,4)))) THEN
2063 
2064  l1b = switch(ibound,5)
2065  l1e = switch(ibound,6)
2066  l2b = switch(ibound,7)
2067  l2e = switch(ibound,8)
2068  lc = switch(ibound,9)
2069 
2070  IF (ibound == 1) THEN
2071  p1(:) = corner(:,1)
2072  p2(:) = corner(:,4)
2073  p3(:) = corner(:,3)
2074  p4(:) = corner(:,2)
2075  ELSE IF (ibound == 2) THEN
2076  p1(:) = corner(:,5)
2077  p2(:) = corner(:,8)
2078  p3(:) = corner(:,7)
2079  p4(:) = corner(:,6)
2080  ELSE IF (ibound == 3) THEN
2081  p1(:) = corner(:,1)
2082  p2(:) = corner(:,2)
2083  p3(:) = corner(:,6)
2084  p4(:) = corner(:,5)
2085  ELSE IF (ibound == 4) THEN
2086  p1(:) = corner(:,4)
2087  p2(:) = corner(:,3)
2088  p3(:) = corner(:,7)
2089  p4(:) = corner(:,8)
2090  ELSE IF (ibound == 5) THEN
2091  p1(:) = corner(:,1)
2092  p2(:) = corner(:,5)
2093  p3(:) = corner(:,8)
2094  p4(:) = corner(:,4)
2095  ELSE IF (ibound == 6) THEN
2096  p1(:) = corner(:,2)
2097  p2(:) = corner(:,6)
2098  p3(:) = corner(:,7)
2099  p4(:) = corner(:,3)
2100  ENDIF
2101 
2102  ds(1:2) = 0._rfreal
2103  DO l2=l2b+1,l2e-1
2104 
2105  sum12 = .true.
2106  ds(3:4) = 0._rfreal
2107  DO l1=l1b+1,l1e-1
2108  IF (ibound==1 .OR. ibound==2) THEN
2109  ijkn = indijk(lc,l1 ,l2 ,inoff,ijnoff)
2110  ijke(1) = indijk(lc,jpnbeg,l2 ,inoff,ijnoff)
2111  ijkem(1) = indijk(lc,jpnbeg,l2-1 ,inoff,ijnoff)
2112  ijke(2) = indijk(lc,jpnend,l2 ,inoff,ijnoff)
2113  ijkem(2) = indijk(lc,jpnend,l2-1 ,inoff,ijnoff)
2114  ijke(3) = indijk(lc,l1 ,kpnbeg,inoff,ijnoff)
2115  ijkem(3) = indijk(lc,l1-1 ,kpnbeg,inoff,ijnoff)
2116  ijke(4) = indijk(lc,l1 ,kpnend,inoff,ijnoff)
2117  ijkem(4) = indijk(lc,l1-1 ,kpnend,inoff,ijnoff)
2118  arclen(1) = arclen56(lc,jpnbeg)
2119  arclen(2) = arclen56(lc,jpnend)
2120  arclen(3) = arclen34(kpnbeg,lc)
2121  arclen(4) = arclen34(kpnend,lc)
2122  ELSE IF (ibound==3 .OR. ibound==4) THEN
2123  ijkn = indijk(l2 ,lc,l1 ,inoff,ijnoff)
2124  ijke(1) = indijk(l2 ,lc,kpnbeg,inoff,ijnoff)
2125  ijkem(1) = indijk(l2-1 ,lc,kpnbeg,inoff,ijnoff)
2126  ijke(2) = indijk(l2 ,lc,kpnend,inoff,ijnoff)
2127  ijkem(2) = indijk(l2-1 ,lc,kpnend,inoff,ijnoff)
2128  ijke(3) = indijk(ipnbeg,lc,l1 ,inoff,ijnoff)
2129  ijkem(3) = indijk(ipnbeg,lc,l1-1 ,inoff,ijnoff)
2130  ijke(4) = indijk(ipnend,lc,l1 ,inoff,ijnoff)
2131  ijkem(4) = indijk(ipnend,lc,l1-1 ,inoff,ijnoff)
2132  arclen(1) = arclen12(lc,kpnbeg)
2133  arclen(2) = arclen12(lc,kpnend)
2134  arclen(3) = arclen56(ipnbeg,lc)
2135  arclen(4) = arclen56(ipnend,lc)
2136  ELSE IF (ibound==5 .OR. ibound==6) THEN
2137  ijkn = indijk(l1 ,l2 ,lc,inoff,ijnoff)
2138  ijke(1) = indijk(ipnbeg,l2 ,lc,inoff,ijnoff)
2139  ijkem(1) = indijk(ipnbeg,l2-1 ,lc,inoff,ijnoff)
2140  ijke(2) = indijk(ipnend,l2 ,lc,inoff,ijnoff)
2141  ijkem(2) = indijk(ipnend,l2-1 ,lc,inoff,ijnoff)
2142  ijke(3) = indijk(l1 ,jpnbeg,lc,inoff,ijnoff)
2143  ijkem(3) = indijk(l1-1 ,jpnbeg,lc,inoff,ijnoff)
2144  ijke(4) = indijk(l1 ,jpnend,lc,inoff,ijnoff)
2145  ijkem(4) = indijk(l1-1 ,jpnend,lc,inoff,ijnoff)
2146  arclen(1) = arclen34(lc,ipnbeg)
2147  arclen(2) = arclen34(lc,ipnend)
2148  arclen(3) = arclen12(jpnbeg,lc)
2149  arclen(4) = arclen12(jpnend,lc)
2150  ENDIF
2151  IF (sum12) THEN
2152  ds(1) = ds(1) + &
2153  sqrt((xyzold(xcoord,ijke(1))-xyzold(xcoord,ijkem(1)))**2 + &
2154  (xyzold(ycoord,ijke(1))-xyzold(ycoord,ijkem(1)))**2 + &
2155  (xyzold(zcoord,ijke(1))-xyzold(zcoord,ijkem(1)))**2)
2156  ds(2) = ds(2) + &
2157  sqrt((xyzold(xcoord,ijke(2))-xyzold(xcoord,ijkem(2)))**2 + &
2158  (xyzold(ycoord,ijke(2))-xyzold(ycoord,ijkem(2)))**2 + &
2159  (xyzold(zcoord,ijke(2))-xyzold(zcoord,ijkem(2)))**2)
2160  sum12 = .false.
2161  ENDIF
2162  ds(3) = ds(3) + &
2163  sqrt((xyzold(xcoord,ijke(3))-xyzold(xcoord,ijkem(3)))**2 + &
2164  (xyzold(ycoord,ijke(3))-xyzold(ycoord,ijkem(3)))**2 + &
2165  (xyzold(zcoord,ijke(3))-xyzold(zcoord,ijkem(3)))**2)
2166  ds(4) = ds(4) + &
2167  sqrt((xyzold(xcoord,ijke(4))-xyzold(xcoord,ijkem(4)))**2 + &
2168  (xyzold(ycoord,ijke(4))-xyzold(ycoord,ijkem(4)))**2 + &
2169  (xyzold(zcoord,ijke(4))-xyzold(zcoord,ijkem(4)))**2)
2170  s(:) = ds(:)/arclen(:)
2171  e1(:) = dnode(:,ijke(1))
2172  e2(:) = dnode(:,ijke(2))
2173  e3(:) = dnode(:,ijke(3))
2174  e4(:) = dnode(:,ijke(4))
2175  CALL rflo_tfint2d( s(1),s(2),s(3),s(4),e1,e2,e3,e4,p1,p2,p3,p4,dn )
2176  dnode(:,ijkn) = dn(:)
2177  ENDDO ! l1
2178  ENDDO ! l2
2179 
2180  ENDIF ! edgeMoved
2181  ENDDO ! iBound
2182 
2183 ! finalize --------------------------------------------------------------------
2184 
2185  CALL deregisterfunction( region%global )
2186 
2187 END SUBROUTINE rflo_mgframebnddeformation
2188 
2189 ! ******************************************************************************
2190 ! End
2191 ! ******************************************************************************
2192 
2193 END MODULE rflo_modmovegridframe
2194 
2195 ! ******************************************************************************
2196 !
2197 ! RCS Revision history:
2198 !
2199 ! $Log: RFLO_ModMoveGridConform.F90,v $
2200 ! Revision 1.33 2009/08/27 14:04:50 mtcampbe
2201 ! Updated to enable burning motion with symmetry boundaries and enhanced
2202 ! burnout code.
2203 !
2204 ! Revision 1.32 2008/12/06 08:44:16 mtcampbe
2205 ! Updated license.
2206 !
2207 ! Revision 1.31 2008/11/19 22:17:27 mtcampbe
2208 ! Added Illinois Open Source License/Copyright
2209 !
2210 ! Revision 1.30 2006/03/18 11:02:12 wasistho
2211 ! screen printed global skewness and minvol
2212 !
2213 ! Revision 1.29 2006/03/05 22:27:32 wasistho
2214 ! fixed syntax error
2215 !
2216 ! Revision 1.28 2006/03/05 21:51:47 wasistho
2217 ! changed computational space coordinates to be based on initial grid
2218 !
2219 ! Revision 1.27 2006/02/11 03:53:10 wasistho
2220 ! made some routines public
2221 !
2222 ! Revision 1.26 2006/01/28 22:52:23 wasistho
2223 ! fixed iEdgeGlo
2224 !
2225 ! Revision 1.25 2005/11/16 22:52:39 wasistho
2226 ! update screen print moveGridFOMS
2227 !
2228 ! Revision 1.24 2005/10/28 07:41:18 wasistho
2229 ! modified FORMAT 1000
2230 !
2231 ! Revision 1.23 2005/10/27 19:19:35 wasistho
2232 ! modified screen print
2233 !
2234 ! Revision 1.22 2005/10/27 05:57:23 wasistho
2235 ! added MoveGridFoms
2236 !
2237 ! Revision 1.21 2005/08/25 23:43:30 wasistho
2238 ! update description text
2239 !
2240 ! Revision 1.20 2005/08/18 19:51:03 wasistho
2241 ! added user define nPass in mgFrameInterface
2242 !
2243 ! Revision 1.19 2005/07/10 21:10:48 wasistho
2244 ! added pointer grid in mgFrameMoveCorners
2245 !
2246 ! Revision 1.18 2005/06/30 19:10:19 wasistho
2247 ! made official last added conditions in mgFrameEdges
2248 !
2249 ! Revision 1.17 2005/06/29 08:37:42 wasistho
2250 ! desribed Conform, Nconform, Nconform1, etc
2251 !
2252 ! Revision 1.16 2005/06/29 02:11:15 wasistho
2253 ! fixed moveGridRegNc to regNc
2254 !
2255 ! Revision 1.15 2005/06/28 23:45:08 rfiedler
2256 ! Bug fixes: l, errFl, nCorns
2257 !
2258 ! Revision 1.14 2005/06/27 01:01:03 wasistho
2259 ! stored tolerance in tol
2260 !
2261 ! Revision 1.13 2005/06/27 00:37:11 wasistho
2262 ! change tolerance in mgFrameSrchNeighbors from 1.e-20 to 1.e-5*edgeLen
2263 !
2264 ! Revision 1.12 2005/06/26 06:25:46 wasistho
2265 ! nReg==72 to nReg==71
2266 !
2267 ! Revision 1.11 2005/06/26 06:12:09 wasistho
2268 ! adding more reegions for titan check in mgFrameSrchCorners
2269 !
2270 ! Revision 1.10 2005/06/26 05:40:04 wasistho
2271 ! bugs fixed in mgFrameCornPoints
2272 !
2273 ! Revision 1.9 2005/06/25 08:12:32 wasistho
2274 ! bug fixed in receiving rvar in mgFrameBCast
2275 !
2276 ! Revision 1.8 2005/06/25 06:16:23 wasistho
2277 ! swap ENDDO and ENDIF in mgframeBroadCast
2278 !
2279 ! Revision 1.7 2005/06/25 03:13:49 wasistho
2280 ! enabled nRegions /= nProcs in type 2 gridmotion
2281 !
2282 ! Revision 1.6 2005/06/13 21:47:23 wasistho
2283 ! changed patch%bcCoupled to patch%bcMotion
2284 !
2285 ! Revision 1.5 2005/06/12 10:56:16 wasistho
2286 ! uncommented second/end TFI procedure
2287 !
2288 ! Revision 1.4 2005/06/12 10:12:16 wasistho
2289 ! commented second/end TFI procedure
2290 !
2291 ! Revision 1.3 2005/06/12 06:21:42 wasistho
2292 ! modified dumax in MgFrameCorrectNeighbors
2293 !
2294 ! Revision 1.2 2005/06/10 19:35:30 wasistho
2295 ! added RFLO_MgFrameCornPoints to public
2296 !
2297 ! Revision 1.1 2005/06/10 19:29:52 wasistho
2298 ! added RFLO_ModMoveGridConform.F90 only for backup
2299 !
2300 !
2301 !
2302 ! ******************************************************************************
2303 
2304 
2305 
2306 
2307 
2308 
2309 
2310 
2311 
2312 
2313 
2314 
2315 
2316 
2317 
2318 
2319 
subroutine rflo_edgedeformation(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE ibeg
subroutine rflo_copygeometrydummy(region)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE jpnbeg
subroutine rflo_calccellcentroids(region)
subroutine rflo_mgframesurfaces(regions, someMoved, iType)
j indices k indices k
Definition: Indexing.h:6
subroutine rflo_mgframeedges(region, iType, boundMoved, allExternal, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
double s
Definition: blastest.C:80
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE kpcbeg
subroutine rflo_arclengthbounds(region, xyz, arcLen12, arcLen34, arcLen56)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE kpnbeg
NT p1
subroutine rflo_tfint2d(s1, s2, s3, s4, e1, e2, e3, e4, p1, p2, p3, p4, xyz)
Definition: RFLO_Tfint.F90:76
subroutine rflo_c2eavgcoeffs(region)
subroutine, public rflo_mgframebroadcast(regions, iselect, iter)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine rflo_extrapolategeometry(region)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE ic
subroutine, public rflo_movegridframe(regions)
subroutine rflo_exchangednoderecv(region, regionSrc, patch, patchSrc, average, dNode)
subroutine rflo_c2favgcoeffs(region)
double sqrt(double d)
Definition: double.h:73
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE jpcbeg
subroutine rflo_changeinteriorgrid(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, xyz)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE ipcend
subroutine rflo_movegridinterfaces(regions)
subroutine rflo_calccontrolvolumes(region)
subroutine rflo_tfint1d(s, p1, p2, xyz)
Definition: RFLO_Tfint.F90:59
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE jpnend
subroutine rflo_getnodeoffset(region, iLev, iNodeOffset, ijNodeOffset)
subroutine rflo_mgframemovecorners(regions)
Definition: patch.h:74
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE knode iend
subroutine rflo_calcfacevectors(region)
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE ipcbeg
subroutine rflo_exchangegeometry(regions)
subroutine rflo_movegridsurfaces(regions, someMoved)
subroutine rflo_generatecoarsegrids(region)
subroutine rflo_getpatchindicesnodes(region, patch, iLev, ibeg, iend, jbeg, jend, kbeg, kend)
logical function isnan(x)
Definition: ModTools.F90:201
subroutine rflo_mgframeinterfaces(regions, iType)
blockLoc i
Definition: read.cpp:79
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE ipnbeg
void int int REAL * x
Definition: read.cpp:74
subroutine rflo_getdeformation(region, boundMoved, dNode)
subroutine, public rflo_mgframesrchneighbors(regions)
subroutine rflo_clearsendrequests(regions, iReg, geometry)
subroutine rflo_calcgridspeeds(region)
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:346
subroutine rflo_getdimensphysnodes(region, iLev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend)
j indices j
Definition: Indexing.h:6
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE jpcend
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE knode jend
subroutine rflo_exchangednodecopy(region, regionSrc, patch, patchSrc, average, dNode, dNodeSrc)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE knode jbeg
subroutine rflo_boundarydeformation(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
long double dist(long double *coord1, long double *coord2, int size)
subroutine rflo_mgframerestoreexternal(region)
subroutine rflo_mgframebnddeformation(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
subroutine grid(bp)
Definition: setup_py.f90:257
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE knode kbeg
subroutine deregisterfunction(global)
Definition: ModError.F90:469
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com 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 **********************************************************************INTERFACE SUBROUTINE ipnend
subroutine rflo_exchangednodesend(region, regionSrc, patch, dNode)
subroutine rflo_checkmetrics(iReg, region)
subroutine rflo_getdimensphys(region, iLev, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend)
RT a() const
Definition: Line_2.h:140
subroutine rflo_laplacegridsmoo(regions, resid)
subroutine rflo_calcfacecentroids(region)
subroutine, public rflo_mgframecornpoints(regions)
subroutine rflo_mgframecorrectneighbors(regions)