Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLO_ModMoveGridNconform2.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: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLO_ModMoveGridNconform2.F90,v 1.35 2009/08/27 14:04:51 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2004 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflo_modmovegridframe
40 
41  USE modglobal, ONLY : t_global
42  USE moddatastruct, ONLY: t_region
43  USE modgrid, ONLY : t_grid
44  USE modbndpatch, ONLY : t_patch
45  USE modparameters
46  USE moddatatypes
47  USE moderror
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52  PRIVATE
53  PUBLIC :: rflo_movegridframe, &
54  rflo_mgframecornpoints, &
55  rflo_mgframebroadcast, &
56  rflo_mgframesrchneighbors, &
57 
58  rflo_mgframecorrectneighbors, &
59  rflo_mgframemovecorners, &
60  rflo_mgframeedges, &
61  rflo_mgframerestoreexternal, &
62  rflo_mgframebnddeformation
63 
64 ! private : RFLO_MgFrameSurface
65 ! RFLO_MgFrameInterfaces
66 
67 ! ******************************************************************************
68 ! Declarations and definitions
69 ! ******************************************************************************
70 
71  CHARACTER(CHRLEN) :: rcsidentstring = &
72  '$RCSfile: RFLO_ModMoveGridNconform2.F90,v $ $Revision: 1.35 $'
73 
74 ! ******************************************************************************
75 ! Routines
76 ! ******************************************************************************
77 
78  CONTAINS
79 
80 !******************************************************************************
81 !
82 ! Purpose: redistribute grid nodes according to the movement of the
83 ! boundaries. This function smoothes the grid globally by
84 ! volume mesh smoothing based on Laplacian propagation.
85 !
86 ! Description: none.
87 !
88 ! Input: regions = data of all grid regions.
89 !
90 ! Output: regions%levels%grid%xyz = new grid coordinates.
91 !
92 ! Notes: grid%xyz temporarily stores nodal displacements. The deformation
93 ! is applied to the finest grid first.
94 !
95 !******************************************************************************
96 
97 SUBROUTINE rflo_movegridframe( regions )
98 
99  USE modinterfaces, ONLY : rflo_movegridsurfaces, rflo_movegridinterfaces, &
100  rflo_changeinteriorgrid, rflo_generatecoarsegrids, &
101  rflo_copygeometrydummy, rflo_extrapolategeometry, &
102  rflo_exchangegeometry, rflo_calcfacevectors, rflo_calccontrolvolumes, &
103  rflo_calccellcentroids, rflo_calcfacecentroids, rflo_c2favgcoeffs, &
104  rflo_c2eavgcoeffs, rflo_checkmetrics, rflo_calcgridspeeds, &
105  rflo_boundarydeformation
106  USE rflo_modlaplacesmoothing, ONLY : rflo_laplacegridsmoo
107 
108  IMPLICIT NONE
109 
110 #ifdef GENX
111  include 'roccomf90.h'
112 #endif
113 
114 ! ... parameters
115  TYPE(t_region), POINTER :: regions(:)
116 
117 ! ... loop variables
118  INTEGER :: ireg, iter, ipatch, ijk
119 
120 ! ... local variables
121  LOGICAL :: somemoved, someremesh
122 
123  INTEGER :: bctype, iremesh, jremesh, nremesh, itype
124 
125  REAL(RFREAL) :: resid, globalresid
126  REAL(RFREAL), POINTER :: xyz(:,:), xyzold(:,:)
127 
128  TYPE(t_grid), POINTER :: grid, gridold
129  TYPE(t_global), POINTER :: global
130  TYPE(t_patch), POINTER :: patch
131 #ifdef GENX
132  DOUBLE PRECISION :: dalpha
133 #endif
134 
135 !******************************************************************************
136 
137  global => regions(1)%global
138 
139  CALL registerfunction( global,'RFLO_MoveGridFrame',&
140  'RFLO_ModMoveGridNconform2.F90' )
141 
142  itype=1
143 
144 #ifdef GENX
145 ! update geometry buffers -----------------------------------------------------
146 
147  dalpha = global%dtMin/global%dTimeSystem
148  CALL com_call_function( global%genxHandleGm,1,dalpha )
149 #endif
150 
151 ! receive and distribute deformations for each region -------------------------
152 
153  CALL rflo_mgframesurfaces( regions,somemoved,itype )
154 
155 ! fix interfaces between regions ----------------------------------------------
156 
157  IF (somemoved) THEN
158  CALL rflo_mgframeinterfaces( regions,itype )
159  ENDIF
160 
161 ! update grid, dummy, corner and edge cells -----------------------------------
162 
163  DO ireg=1,global%nRegions
164  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
165  regions(ireg)%active==active .AND. & ! on my processor
166  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
167 
168 ! --- change the interior grid
169 
170  grid => regions(ireg)%levels(1)%grid
171  gridold => regions(ireg)%levels(1)%gridOld
172  CALL rflo_changeinteriorgrid( regions(ireg),grid%boundMoved, &
173  grid%edgeMoved,grid%arcLen12, &
174  grid%arcLen34,grid%arcLen56, &
175  gridold%xyzOld,grid%xyz )
176 
177 ! --- update coarse grids and dummy cells
178 
179  CALL rflo_generatecoarsegrids( regions(ireg) ) ! coarsen finest grid
180  CALL rflo_copygeometrydummy( regions(ireg) ) ! copy to dummy nodes
181  CALL rflo_extrapolategeometry( regions(ireg) ) ! extrapolate
182  ENDIF ! region on this processor and active, grid moving
183  ENDDO ! iReg
184  CALL rflo_exchangegeometry( regions ) ! exchange geometry
185 
186 ! smooth grid by solving Laplace equation -------------------------------------
187 
188  IF (global%moveGridNiter < 1) THEN
189  IF (global%verbLevel >= verbose_high) THEN
190  IF (global%myProcid == masterproc) THEN
191  WRITE(stdout,4000) solver_name,global%skewness,global%minVol
192  WRITE(stdout,1000) solver_name, &
193  global%moveGridNiter,global%moveGridNsmatch, &
194  global%moveGridAmplifX,global%moveGridAmplifY, &
195  global%moveGridAmplifZ,global%moveGridPower
196  ENDIF ! masterproc
197  ENDIF ! verbLevel
198  goto 888
199  ENDIF ! niter<1
200 
201  IF (somemoved) THEN
202  DO iter=1,global%moveGridNiter
203  CALL rflo_laplacegridsmoo( regions,resid )
204  ENDDO
205 
206  IF (global%verbLevel >= verbose_high) THEN
207 #ifdef MPI
208  CALL mpi_reduce( resid,globalresid,1,mpi_rfreal,mpi_sum, &
209  masterproc,global%mpiComm,global%mpierr )
210  IF (global%mpierr /= 0) CALL errorstop( global,err_mpi_trouble,__line__ )
211 #else
212  globalresid = resid
213 #endif
214  IF (global%myProcid == masterproc) THEN
215  WRITE(stdout,4000) solver_name,global%skewness,global%minVol
216 
217  IF (global%moveGridScheme==movegrid_frame) THEN
218  WRITE(stdout,2000) solver_name, &
219  global%moveGridNiter,global%moveGridNsmatch, &
220  global%moveGridAmplifX,global%moveGridAmplifY, &
221  global%moveGridAmplifZ,global%moveGridPower, &
222  sqrt(globalresid)
223  ELSEIF (global%moveGridScheme==movegrid_foms) THEN
224  WRITE(stdout,3000) solver_name, &
225  global%moveGridNiter,global%moveGridNsmatch, &
226  global%moveGridAmplifX,global%moveGridAmplifY, &
227  global%moveGridAmplifZ,global%moveGridPower, &
228  global%moveGridWeight,global%moveGridOrthCell, &
229  sqrt(globalresid)
230  ENDIF
231  ENDIF
232  ENDIF ! verbLevel
233  ENDIF ! someMoved
234 
235 ! update grid, dummy, corner and edge cells -----------------------------------
236 
237  DO ireg=1,global%nRegions
238  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
239  regions(ireg)%active==active .AND. & ! on my processor
240  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
241 
242 ! --- change xyz from coordinates to deformations
243 
244  xyz => regions(ireg)%levels(1)%grid%xyz
245  xyzold => regions(ireg)%levels(1)%gridOld%xyz
246 
247  DO ijk=lbound(xyz,2),ubound(xyz,2)
248  xyz(xcoord,ijk) = xyz(xcoord,ijk) - xyzold(xcoord,ijk)
249  xyz(ycoord,ijk) = xyz(ycoord,ijk) - xyzold(ycoord,ijk)
250  xyz(zcoord,ijk) = xyz(zcoord,ijk) - xyzold(zcoord,ijk)
251  ENDDO
252 
253 ! --- redistribute deformations at boundaries
254 
255  grid => regions(ireg)%levels(1)%grid
256  gridold => regions(ireg)%levels(1)%gridOld
257  grid%boundMoved(:) = .true.
258  grid%edgeMoved(:) = .true.
259  DO ipatch=1,regions(ireg)%nPatches
260  patch => regions(ireg)%levels(1)%patches(ipatch)
261  bctype = patch%bcType
262 ! IF ((bcType>=BC_SYMMETRY .AND. bcType<=BC_SYMMETRY+BC_RANGE)) THEN
263 ! grid%boundMoved(patch%lbound) = .false.
264 ! ENDIF ! bcType
265  IF ((bctype==bc_symmetry)) THEN
266  grid%boundMoved(patch%lbound) = .false.
267  ENDIF ! bcType
268  ENDDO ! iPatch
269  CALL rflo_boundarydeformation( regions(ireg),grid%boundMoved, &
270  grid%edgeMoved,grid%arcLen12, &
271  grid%arcLen34,grid%arcLen56, &
272  gridold%xyzOld,grid%xyz )
273 
274 ! --- change xyz from deformations to coordinates
275 
276  CALL rflo_changeinteriorgrid( regions(ireg),grid%boundMoved, &
277  grid%edgeMoved,grid%arcLen12, &
278  grid%arcLen34,grid%arcLen56, &
279  gridold%xyzOld,grid%xyz )
280 
281 ! --- update coarse grids and dummy cells
282 
283  CALL rflo_generatecoarsegrids( regions(ireg) ) ! coarsen finest grid
284  CALL rflo_copygeometrydummy( regions(ireg) ) ! copy to dummy nodes
285  CALL rflo_extrapolategeometry( regions(ireg) ) ! extrapolate
286  ENDIF ! region on this processor and active, grid moving
287 ENDDO ! iReg
288 
289 CALL rflo_exchangegeometry( regions ) ! exchange geometry
290 
291 888 CONTINUE
292 
293 ! calculate new metrics and grid speeds ---------------------------------------
294 
295  someremesh = .false.
296  iremesh = 0
297  DO ireg=1,global%nRegions
298  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
299  regions(ireg)%active==active .AND. & ! on my processor
300  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
301  CALL rflo_calcfacevectors( regions(ireg) ) ! faces
302  CALL rflo_calccontrolvolumes( regions(ireg) ) ! volumes
303  CALL rflo_calccellcentroids( regions(ireg) ) ! cell centroids
304  IF (global%moveGridScheme==movegrid_foms) &
305  CALL rflo_calcfacecentroids( regions(ireg) ) ! face centroids
306  IF (regions(ireg)%mixtInput%faceEdgeAvg==fe_avg_linear) &
307  CALL rflo_c2favgcoeffs( regions(ireg) ) ! cell2face averaging
308  CALL rflo_c2eavgcoeffs( regions(ireg) ) ! cell2edge averaging
309  CALL rflo_checkmetrics( ireg,regions(ireg) ) ! check metrics
310 ! IF (regions(iReg)%levels(1)%grid%remesh==1) THEN
311 ! CALL RFLO_GridRemesh( regions(iReg) ) ! grid remeshing
312 ! iRemesh=1
313 ! ENDIF
314  CALL rflo_calcgridspeeds( regions(ireg) ) ! grid speeds
315  ENDIF ! region on this processor and active, grid moving
316  ENDDO ! iReg
317 
318 #ifdef MPI
319  CALL mpi_allreduce( iremesh, nremesh, 1, mpi_integer, mpi_sum, &
320  global%mpiComm, global%mpierr )
321  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
322  IF (nremesh > 0) someremesh = .true.
323 #endif
324 
325  IF (someremesh) THEN
326  CALL rflo_exchangegeometry( regions ) ! exchange geometry
327  DO ireg=1,global%nRegions
328  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
329  regions(ireg)%active==active .AND. & ! on my processor
330  iremesh==1) THEN ! and remeshing
331  CALL rflo_calcfacevectors( regions(ireg) ) ! faces
332  CALL rflo_calccontrolvolumes( regions(ireg) ) ! volumes
333  CALL rflo_calccellcentroids( regions(ireg) ) ! cell centroids
334  IF (global%moveGridScheme==movegrid_foms) &
335  CALL rflo_calcfacecentroids( regions(ireg) ) ! face centroids
336  IF (regions(ireg)%mixtInput%faceEdgeAvg==fe_avg_linear) &
337  CALL rflo_c2favgcoeffs( regions(ireg) ) ! cell2face averaging
338  CALL rflo_c2eavgcoeffs( regions(ireg) ) ! cell2edge averaging
339  ENDIF ! region on this processor and active, grid moving
340  ENDDO ! iReg
341  ENDIF
342 
343 ! finalize --------------------------------------------------------------------
344 
345  CALL deregisterfunction( global )
346 
347 1000 FORMAT(a,1x,'Global-TFI grid motion:',2i5,4(1pe9.2))
348 2000 FORMAT(a,1x,'Global-Weighted-Laplacian grid motion:',2i5,4(1pe9.2),1pe13.4)
349 3000 FORMAT(a,1x,'Global-Orthogonal-Laplacian gridmotion:',2i3,6(1pe9.2),1pe10.2)
350 4000 FORMAT(a,1x,'global skewness, minvol:',2(1pe14.5))
351 
352 END SUBROUTINE rflo_movegridframe
353 
354 !******************************************************************************
355 !
356 ! Purpose: search for corner points including those of internal patches
357 !
358 ! Description: none.
359 !
360 ! Input: regions = data of current region.
361 !
362 ! Output: grid%nCorns = number of corner points in each region
363 ! grid%ijkCorn = ijkValue of each corner
364 !
365 ! Notes: none.
366 !
367 !******************************************************************************
368 
369 SUBROUTINE rflo_mgframecornpoints( regions )
370 
371  USE modinterfaces, ONLY : rflo_getnodeoffset, &
372  rflo_getdimensphysnodes, rflo_getpatchindicesnodes
373 
374  IMPLICIT NONE
375 #include "Indexing.h"
376 
377 ! ... parameters
378  TYPE(t_region), POINTER :: regions(:)
379 
380 ! ... loop variables
381  INTEGER :: l, ipatch, ireg, ipcorn, intcorn, nreg
382 
383 ! ... local variables
384  INTEGER, PARAMETER :: ncmax=100
385  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
386  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend
387  INTEGER :: iptc, jptc, kptc, iblk, jblk, kblk, ijkcurr
388  INTEGER :: inoff, ijnoff, lbound, regnc, errfl
389  INTEGER, ALLOCATABLE :: ivar(:), ijkcorn(:,:)
390  LOGICAL :: wasfound
391 
392  TYPE(t_patch), POINTER :: patch
393  TYPE(t_grid), POINTER :: grid
394  TYPE(t_global), POINTER :: global
395 
396 !******************************************************************************
397 
398  global => regions(1)%global
399 
400  CALL registerfunction( global,'RFLO_MgFrameCornPoints',&
401  'RFLO_ModMoveGridNconform2.F90' )
402 
403 ! search for block and patch corners in each region ---------------------------
404 
405  ALLOCATE( ivar(global%nRegions),stat=errfl )
406  global%error = errfl
407  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
408 
409  ALLOCATE( ijkcorn(ncmax,global%nRegions),stat=errfl )
410  global%error = errfl
411  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
412 
413  ilev = 1
414 
415  DO ireg = 1,global%nRegions
416  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
417  regions(ireg)%active==active) THEN ! on my processor
418 
419  grid => regions(ireg)%levels(ilev)%grid
420 
421  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
422  jpnbeg,jpnend,kpnbeg,kpnend )
423  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
424 
425 ! --- search for internal patch corners
426 
427  grid%nCorns(ireg) = 8
428  ijkcorn(1,ireg) = indijk(ipnbeg,jpnbeg,kpnbeg,inoff,ijnoff)
429  ijkcorn(2,ireg) = indijk(ipnbeg,jpnbeg,kpnend,inoff,ijnoff)
430  ijkcorn(3,ireg) = indijk(ipnbeg,jpnend,kpnend,inoff,ijnoff)
431  ijkcorn(4,ireg) = indijk(ipnbeg,jpnend,kpnbeg,inoff,ijnoff)
432  ijkcorn(5,ireg) = indijk(ipnend,jpnbeg,kpnbeg,inoff,ijnoff)
433  ijkcorn(6,ireg) = indijk(ipnend,jpnbeg,kpnend,inoff,ijnoff)
434  ijkcorn(7,ireg) = indijk(ipnend,jpnend,kpnend,inoff,ijnoff)
435  ijkcorn(8,ireg) = indijk(ipnend,jpnend,kpnbeg,inoff,ijnoff)
436 
437  DO ipatch=1,regions(ireg)%nPatches
438  patch => regions(ireg)%levels(ilev)%patches(ipatch)
439  lbound = patch%lbound
440 
441  CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
442  ibeg,iend,jbeg,jend,kbeg,kend )
443 
444  DO ipcorn = 1,4 ! patch corners
445  IF (lbound==1 .OR. lbound==2) THEN
446  iptc = ibeg
447  IF (lbound==1) iblk = ipnbeg
448  IF (lbound==2) iblk = ipnend
449  IF (ipcorn==1) THEN
450  jptc = jbeg
451  jblk = jpnbeg
452  kptc = kbeg
453  kblk = kpnbeg
454  ELSEIF (ipcorn==2) THEN
455  jptc = jbeg
456  jblk = jpnbeg
457  kptc = kend
458  kblk = kpnend
459  ELSEIF (ipcorn==3) THEN
460  jptc = jend
461  jblk = jpnend
462  kptc = kend
463  kblk = kpnend
464  ELSEIF (ipcorn==4) THEN
465  jptc = jend
466  jblk = jpnend
467  kptc = kbeg
468  kblk = kpnbeg
469  ENDIF
470  ELSEIF (lbound==3 .OR. lbound==4) THEN
471  jptc = jbeg
472  IF (lbound==3) jblk = jpnbeg
473  IF (lbound==4) jblk = jpnend
474  IF (ipcorn==1) THEN
475  kptc = kbeg
476  kblk = kpnbeg
477  iptc = ibeg
478  iblk = ipnbeg
479  ELSEIF (ipcorn==2) THEN
480  kptc = kbeg
481  kblk = kpnbeg
482  iptc = iend
483  iblk = ipnend
484  ELSEIF (ipcorn==3) THEN
485  kptc = kend
486  kblk = kpnend
487  iptc = iend
488  iblk = ipnend
489  ELSEIF (ipcorn==4) THEN
490  kptc = kend
491  kblk = kpnend
492  iptc = ibeg
493  iblk = ipnbeg
494  ENDIF ! ipCorn
495  ELSEIF (lbound==5 .OR. lbound==6) THEN
496  kptc = kbeg
497  IF (lbound==5) kblk = kpnbeg
498  IF (lbound==6) kblk = kpnend
499  IF (ipcorn==1) THEN
500  iptc = ibeg
501  iblk = ipnbeg
502  jptc = jbeg
503  jblk = jpnbeg
504  ELSEIF (ipcorn==2) THEN
505  iptc = ibeg
506  iblk = ipnbeg
507  jptc = jend
508  jblk = jpnend
509  ELSEIF (ipcorn==3) THEN
510  iptc = iend
511  iblk = ipnend
512  jptc = jend
513  jblk = jpnend
514  ELSEIF (ipcorn==4) THEN
515  iptc = iend
516  iblk = ipnend
517  jptc = jbeg
518  jblk = jpnbeg
519  ENDIF ! ipCorn
520  ENDIF ! lbound
521 
522  patch%corns(ipcorn) = indijk(iptc,jptc,kptc,inoff,ijnoff)
523 
524  IF (iptc/=iblk .OR. jptc/=jblk .OR. kptc/=kblk) THEN
525  wasfound = .false.
526  ijkcurr = indijk(iptc,jptc,kptc,inoff,ijnoff)
527  DO intcorn=1,grid%nCorns(ireg)
528  IF (ijkcorn(intcorn,ireg)==ijkcurr) THEN
529  wasfound = .true.
530  ENDIF
531  ENDDO
532  IF (.NOT. wasfound) THEN
533  grid%nCorns(ireg) = grid%nCorns(ireg) +1
534  ijkcorn(grid%nCorns(ireg),ireg) = ijkcurr
535  ENDIF
536  ENDIF
537  IF (grid%nCorns(ireg) >= ncmax) THEN
538  CALL errorstop( global,err_illegal_value,__line__, &
539  'too low ncMax in RFLO_ModMoveGridNconform/RFLO_MgFrameCornPoints')
540  ENDIF
541  ENDDO ! ipCorn
542  ENDDO ! iPatch
543 
544  ivar(ireg) = grid%nCorns(ireg)
545  ENDIF ! myProcid
546  ENDDO ! iReg
547 
548 #ifdef MPI
549  DO ireg = 1,global%nRegions
550  CALL mpi_bcast( ivar(ireg),1,mpi_integer, &
551  regions(ireg)%procId,global%mpiComm,global%mpierr )
552  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
553 
554  CALL mpi_bcast( ijkcorn(1:ncmax,ireg),ncmax,mpi_integer, &
555  regions(ireg)%procId,global%mpiComm,global%mpierr )
556  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
557  ENDDO
558 #endif
559 
560  regnc = 0
561  DO ireg = 1,global%nRegions
562  regnc = max( regnc,ivar(ireg) )
563  ENDDO
564  global%moveGridRegNc = regnc
565 
566  DO ireg = 1,global%nRegions
567  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
568  regions(ireg)%active==active) THEN ! on my processor
569 
570  grid => regions(ireg)%levels(ilev)%grid
571  DO nreg = 1,global%nRegions
572  grid%nCorns(nreg) = ivar(nreg)
573  ENDDO
574 
575  ALLOCATE( grid%ijkCorn( regnc,global%nRegions),stat=errfl )
576  global%error = errfl
577  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
578 
579  ALLOCATE( grid%regCorn( 3,regnc,global%nRegions),stat=errfl )
580  global%error = errfl
581  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
582 
583  ALLOCATE( grid%regCornOld( 3,regnc,global%nRegions),stat=errfl )
584  global%error = errfl
585  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
586 
587  ALLOCATE( grid%regCornOrig(3,regnc,global%nRegions),stat=errfl )
588  global%error = errfl
589  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
590 
591  ALLOCATE( grid%nghbor( 3,global%moveGridNbour,regnc),stat=errfl )
592  global%error = errfl
593  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
594 
595  DO l = 1,grid%nCorns(ireg)
596  grid%ijkCorn(l,ireg) = ijkcorn(l,ireg)
597  ENDDO
598 
599  ENDIF ! myProcid
600  ENDDO ! iReg
601 
602 ! deallocate temporary arrays
603 
604  DEALLOCATE( ivar,stat=errfl )
605  global%error = errfl
606  IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )
607 
608 ! finalize --------------------------------------------------------------------
609 
610  CALL deregisterfunction( global )
611 
612 END SUBROUTINE rflo_mgframecornpoints
613 
614 !******************************************************************************
615 !
616 ! Purpose: broadcast movements at 8 corner points of current region to all
617 ! regions
618 !
619 ! Description: none.
620 !
621 ! Input: regions = data of all grid regions.
622 !
623 ! Notes: upon first call by RFLO_InitGridProcedure, regions%levels%grid%xyz
624 ! contains grid coordinates, but on second call by RFLO_MgFrameSurface
625 ! regions%levels%grid%xyz contains grid movements.
626 !
627 !******************************************************************************
628 
629 SUBROUTINE rflo_mgframebroadcast( regions,iselect,iter )
630 
631  USE modinterfaces, ONLY : rflo_getdimensphysnodes, rflo_getnodeoffset
632  IMPLICIT NONE
633 
634 #include "Indexing.h"
635 
636 ! ... parameters
637  TYPE(t_region), POINTER :: regions(:)
638  INTEGER :: iselect, iter
639 
640 ! ... loop variables
641  INTEGER :: i, l, ireg
642 
643 ! ... local variables
644  INTEGER :: ilev, ncorns, errfl
645  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, inoff, ijnoff
646  INTEGER, ALLOCATABLE :: corner(:)
647 
648  REAL(RFREAL), ALLOCATABLE :: rvar(:,:,:)
649  REAL(RFREAL), POINTER :: dxyz(:,:)
650 
651  TYPE(t_global), POINTER :: global
652  TYPE(t_grid), POINTER :: grid, gridold
653 
654 !******************************************************************************
655 
656  global => regions(1)%global
657 
658  CALL registerfunction( global,'RFLO_MgFrameBroadcast',&
659  'RFLO_ModMoveGridNconform2.F90' )
660 
661 ! store block corners and broadcast to all regions ----------------------------
662 
663  ALLOCATE( rvar(xcoord:zcoord,global%moveGridRegNc,global%nRegions), &
664  stat=errfl )
665  global%error = errfl
666  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
667  rvar = 0._rfreal
668 
669  ilev = 1
670 
671  DO ireg = 1,global%nRegions
672  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
673  regions(ireg)%active==active) THEN ! on my processor
674 
675  grid => regions(ireg)%levels(ilev)%grid
676 ! gridOld => regions(iReg)%levels(iLev)%gridOld
677 
678  IF (iter==1) THEN
679  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
680  jpnbeg,jpnend,kpnbeg,kpnend )
681  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
682 
683  dxyz => grid%xyz
684  ncorns = grid%nCorns(ireg)
685 
686  ALLOCATE( corner(ncorns), stat=errfl )
687  global%error = errfl
688  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
689 
690  DO l = 1,ncorns
691  corner(l) = grid%ijkCorn(l,ireg)
692  ENDDO
693 
694  IF (iselect==1) THEN
695  DO i=1,ncorns
696  grid%regCornOld(xcoord,i,ireg) = dxyz(xcoord,corner(i))
697  grid%regCornOld(ycoord,i,ireg) = dxyz(ycoord,corner(i))
698  grid%regCornOld(zcoord,i,ireg) = dxyz(zcoord,corner(i))
699  rvar(:,i,ireg) = grid%regCornOld(:,i,ireg)
700  ENDDO
701  ELSE
702  DO i=1,ncorns
703  grid%regCornOrig(xcoord,i,ireg) = dxyz(xcoord,corner(i))
704  grid%regCornOrig(ycoord,i,ireg) = dxyz(ycoord,corner(i))
705  grid%regCornOrig(zcoord,i,ireg) = dxyz(zcoord,corner(i))
706  rvar(:,i,ireg) = grid%regCornOrig(:,i,ireg)
707  ENDDO
708  ENDIF
709 
710  DEALLOCATE( corner, stat=errfl )
711  global%error = errfl
712  IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )
713 
714  ELSE
715  rvar(:,:,ireg) = grid%regCornOld(:,:,ireg)
716 
717  ENDIF ! iter
718  ENDIF ! myProcid
719  ENDDO ! iReg
720 
721 #ifdef MPI
722  DO ireg = 1,global%nRegions
723  ncorns = global%moveGridRegNc
724 
725  CALL mpi_bcast( rvar(xcoord:zcoord,1:ncorns,ireg),3*ncorns, &
726  mpi_rfreal,regions(ireg)%procId,global%mpiComm,global%mpierr )
727  IF (global%mpierr /=0 ) CALL errorstop( global,err_mpi_trouble,__line__ )
728  ENDDO
729  CALL mpi_barrier( global%mpiComm,global%mpierr )
730 
731  DO ireg = 1,global%nRegions
732  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
733  regions(ireg)%active==active) THEN ! on my processor
734 
735  grid => regions(ireg)%levels(ilev)%grid
736  IF (iter == 1) THEN
737  IF (iselect==1) THEN
738  DO l=1,global%nRegions
739  grid%regCornOld(:,:,l) = rvar(:,:,l)
740  ENDDO
741  ELSE
742  DO l=1,global%nRegions
743  grid%regCornOrig(:,:,l) = rvar(:,:,l)
744  ENDDO
745  ENDIF
746  ELSE
747  DO l=1,global%nRegions
748  grid%regCornOld(:,:,l) = rvar(:,:,l)
749  ENDDO
750  ENDIF ! iter
751  ENDIF ! myProcid
752  ENDDO ! iReg
753 
754 ! DO iReg = 1,global%nRegions
755 ! IF (regions(iReg)%procid==global%myProcid .AND. & ! region active and
756 ! regions(iReg)%active==ACTIVE) THEN ! on my processor
757 ! grid => regions(1)%levels(iLev)%grid
758 ! DO l = 1,global%nRegions
759 ! DO i=1,grid%nCorns(iReg)
760 ! write(*,*)iReg,l,i,grid%regCornOrig(:,i,l)
761 ! ENDDO
762 ! ENDDO
763 ! ENDIF
764 ! ENDDO
765 #endif
766 
767 ! deallocate temporary arrays
768 
769  DEALLOCATE( rvar,stat=errfl )
770  global%error = errfl
771  IF (global%error /= 0) CALL errorstop( global,err_deallocate,__line__ )
772 
773 ! finalize --------------------------------------------------------------------
774 
775  CALL deregisterfunction( global )
776 
777 END SUBROUTINE rflo_mgframebroadcast
778 
779 !******************************************************************************
780 !
781 ! Purpose: search for six closest neighbors
782 !
783 ! Description: none.
784 !
785 ! Input: regions = data of current region.
786 !
787 ! Output: grid%nghbor = neighbouring points identified
788 !
789 ! Notes: none
790 !
791 !******************************************************************************
792 
793 SUBROUTINE rflo_mgframesrchneighbors( regions )
794 
795  USE modinterfaces, ONLY : rflo_getdimensphys, rflo_getnodeoffset, &
796  rflo_getdimensphysnodes, rflo_getpatchindicesnodes
797 
798  IMPLICIT NONE
799 #include "Indexing.h"
800 
801 ! ... parameters
802  TYPE(t_region), POINTER :: regions(:)
803 
804 ! ... loop variables
805  INTEGER :: i, j, k, ipatch, ic, ireg, nc, nreg
806 
807 ! ... local variables
808  INTEGER :: ilev, bctype, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
809  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
810  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ncorns, nbour
811  INTEGER :: ijknode(4), inoff, ijnoff, lbound, errfl
812  INTEGER, ALLOCATABLE :: ncmin(:), nregmin(:)
813  REAL(RFREAL) :: edgelen, ds, tol
814  REAL(RFREAL), POINTER :: xyz(:,:)
815  REAL(RFREAL), ALLOCATABLE :: dist(:,:), distmin(:)
816 
817  TYPE(t_patch), POINTER :: patch
818  TYPE(t_grid), POINTER :: grid
819  TYPE(t_global), POINTER :: global
820 
821 !******************************************************************************
822 
823  global => regions(1)%global
824 
825  CALL registerfunction( global,'RFLO_MgFrameSrchNeighbors',&
826  'RFLO_ModMoveGridNconform2.F90' )
827 
828 ! search for six closest neighbours -------------------------------------------
829 
830  nbour = global%moveGridNbour ! number of closest neighbours
831  ilev = 1
832 
833  ALLOCATE( ncmin(nbour), stat=errfl ); IF (errfl>0) goto 88
834  ALLOCATE( nregmin(nbour), stat=errfl ); IF (errfl>0) goto 88
835  ALLOCATE( distmin(nbour), stat=errfl ); IF (errfl>0) goto 88
836  ALLOCATE( dist(global%moveGridRegNc,global%nRegions), stat=errfl )
837  IF (errfl>0) goto 88
838 
839  DO ireg = 1,global%nRegions
840  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
841  regions(ireg)%active==active) THEN ! on my processor
842 
843  grid => regions(ireg)%levels(ilev)%grid
844 
845  ncorns = grid%nCorns(ireg)
846 
847  CALL rflo_getdimensphys( regions(ireg),ilev,ipcbeg,ipcend, &
848  jpcbeg,jpcend,kpcbeg,kpcend )
849  CALL rflo_getdimensphysnodes( regions(ireg),ilev,ipnbeg,ipnend, &
850  jpnbeg,jpnend,kpnbeg,kpnend )
851  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
852 
853  xyz => regions(ireg)%levels(ilev)%grid%xyz
854 
855 ! --- calculate the shortest cell edge
856 
857  edgelen = 1.e+30_rfreal
858 
859  DO k=kpcbeg,kpcend
860  DO j=jpcbeg,jpcend
861  DO i=ipcbeg,ipcend
862  ijknode(1) = indijk(i ,j ,k ,inoff,ijnoff)
863  ijknode(2) = indijk(i+1,j ,k ,inoff,ijnoff)
864  ijknode(3) = indijk(i ,j+1,k ,inoff,ijnoff)
865  ijknode(4) = indijk(i ,j ,k+1,inoff,ijnoff)
866  ds = sqrt((xyz(xcoord,ijknode(2))-xyz(xcoord,ijknode(1)))**2+ &
867  (xyz(ycoord,ijknode(2))-xyz(ycoord,ijknode(1)))**2+ &
868  (xyz(zcoord,ijknode(2))-xyz(zcoord,ijknode(1)))**2)
869  edgelen = min(edgelen,ds)
870  ds = sqrt((xyz(xcoord,ijknode(3))-xyz(xcoord,ijknode(1)))**2+ &
871  (xyz(ycoord,ijknode(3))-xyz(ycoord,ijknode(1)))**2+ &
872  (xyz(zcoord,ijknode(3))-xyz(zcoord,ijknode(1)))**2)
873  edgelen = min(edgelen,ds)
874  ds = sqrt((xyz(xcoord,ijknode(4))-xyz(xcoord,ijknode(1)))**2+ &
875  (xyz(ycoord,ijknode(4))-xyz(ycoord,ijknode(1)))**2+ &
876  (xyz(zcoord,ijknode(4))-xyz(zcoord,ijknode(1)))**2)
877  edgelen = min(edgelen,ds)
878  ENDDO
879  ENDDO
880  ENDDO
881  tol = 1.e-5_rfreal*edgelen
882 
883  DO ic = 1,ncorns
884  distmin(1:nbour) = 1.e+30_rfreal
885  ncmin(1:nbour) = 1
886  nregmin(1:nbour) = 1
887  DO nreg = 1,global%nRegions
888  DO nc = 1,grid%nCorns(nreg)
889  dist(nc,nreg) = sqrt((grid%regCornOrig(xcoord,nc,nreg)- &
890  grid%regCornOrig(xcoord,ic,ireg))**2 + &
891  (grid%regCornOrig(ycoord,nc,nreg)- &
892  grid%regCornOrig(ycoord,ic,ireg))**2 + &
893  (grid%regCornOrig(zcoord,nc,nreg)- &
894  grid%regCornOrig(zcoord,ic,ireg))**2)
895 
896 ! -------- inhibitor check
897 ! IF (dist(nc,nReg)>edgeLen .AND. iReg==12 .AND. ic==5 .AND. &
898 ! (nReg==12 .OR. nReg==14 .OR. nReg==18 .OR. nReg==25 .OR. &
899 ! nReg==26 .OR. nReg==52 .OR. nReg==69)) &
900 ! write(*,*)'i',iReg,ic,nReg,nc,dist(nc,nReg)
901 
902 ! -------- titan4-240blocks check
903 ! IF (dist(nc,nReg)>edgeLen .AND. iReg==120 .AND. ic==6 .AND. &
904 ! (nReg==96 .OR. nReg==37 .OR. nReg==105 .OR. nReg==121 .OR. &
905 ! nReg==117 .OR. nReg==123 .OR. nReg==71 .OR. nReg==72 .OR. &
906 ! nReg==120)) write(*,*)'i',iReg,ic,nReg,nc,dist(nc,nReg)
907 
908  IF (dist(nc,nreg)<distmin(1) .AND. dist(nc,nreg)>edgelen) THEN
909  DO k = nbour,2,-1
910  distmin(k) = distmin(k-1)
911  ncmin(k) = ncmin(k-1)
912  nregmin(k) = nregmin(k-1)
913  ENDDO
914  distmin(1) = dist(nc,nreg)
915  ncmin(1) = nc
916  nregmin(1) = nreg
917  ENDIF
918 
919  DO k = 2,nbour
920  IF (dist(nc,nreg) > (distmin(k-1) + tol) .AND. &
921  dist(nc,nreg) < (distmin(k) - tol)) THEN
922 ! ------------- titan4-240blocks check
923 ! IF (iReg==120 .AND. ic==6) write(*,*)'j',iReg,ic,nReg, &
924 ! nc,k,dist(nc,nReg),distMin(k-1),distMin(k)
925  DO j = nbour,k+1,-1
926  distmin(j) = distmin(j-1)
927  ncmin(j) = ncmin(j-1)
928  nregmin(j) = nregmin(j-1)
929  ENDDO
930  distmin(k) = dist(nc,nreg)
931  ncmin(k) = nc
932  nregmin(k) = nreg
933  ENDIF
934  ENDDO
935 
936  ENDDO ! nc
937  ENDDO ! nReg
938 
939  DO k = 1,nbour
940  nc = ncmin(k)
941  nreg = nregmin(k)
942  grid%nghbor(1,k,ic) = nc
943  grid%nghbor(2,k,ic) = nreg
944  ENDDO ! k
945  ENDDO ! ic
946 
947  grid%nghbor(3,:,:) = 1
948 
949  ENDIF ! myProcid
950  ENDDO ! iReg
951 
952 ! deallocate temporary arrays -------------------------------------------------
953 
954  DEALLOCATE( ncmin, stat=errfl ); IF (errfl>0) goto 99
955  DEALLOCATE( nregmin, stat=errfl ); IF (errfl>0) goto 99
956  DEALLOCATE( distmin, stat=errfl ); IF (errfl>0) goto 99
957  DEALLOCATE( dist, stat=errfl ); IF (errfl>0) goto 99
958 
959 ! assign internal/external flag to block corners
960 
961  DO ireg = 1,global%nRegions
962  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
963  regions(ireg)%active==active) THEN ! on my processor
964 
965  grid => regions(ireg)%levels(ilev)%grid
966 
967 ! --- corner 1
968  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(1)%interact).OR. &
969  (.NOT. regions(ireg)%levels(ilev)%edgeCells(1)%interact).OR. &
970  (.NOT. regions(ireg)%levels(ilev)%edgeCells(4)%interact).OR. &
971  (.NOT. regions(ireg)%levels(ilev)%edgeCells(9)%interact)) &
972  grid%nghbor(3,1:nbour,1) = 0
973 
974 ! --- corner 2
975  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(2)%interact).OR. &
976  (.NOT. regions(ireg)%levels(ilev)%edgeCells(1)%interact).OR. &
977  (.NOT. regions(ireg)%levels(ilev)%edgeCells(2)%interact).OR. &
978  (.NOT. regions(ireg)%levels(ilev)%edgeCells(10)%interact)) &
979  grid%nghbor(3,1:nbour,2) = 0
980 
981 ! --- corner 3
982  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(3)%interact).OR. &
983  (.NOT. regions(ireg)%levels(ilev)%edgeCells(2)%interact).OR. &
984  (.NOT. regions(ireg)%levels(ilev)%edgeCells(3)%interact).OR. &
985  (.NOT. regions(ireg)%levels(ilev)%edgeCells(11)%interact)) &
986  grid%nghbor(3,1:nbour,3) = 0
987 
988 ! --- corner 4
989  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(4)%interact).OR. &
990  (.NOT. regions(ireg)%levels(ilev)%edgeCells(3)%interact).OR. &
991  (.NOT. regions(ireg)%levels(ilev)%edgeCells(4)%interact).OR. &
992  (.NOT. regions(ireg)%levels(ilev)%edgeCells(12)%interact)) &
993  grid%nghbor(3,1:nbour,4) = 0
994 
995 ! --- corner 5
996  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(5)%interact).OR. &
997  (.NOT. regions(ireg)%levels(ilev)%edgeCells(5)%interact).OR. &
998  (.NOT. regions(ireg)%levels(ilev)%edgeCells(8)%interact).OR. &
999  (.NOT. regions(ireg)%levels(ilev)%edgeCells(9)%interact)) &
1000  grid%nghbor(3,1:nbour,5) = 0
1001 
1002 ! --- corner 6
1003  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(6)%interact).OR. &
1004  (.NOT. regions(ireg)%levels(ilev)%edgeCells(5)%interact).OR. &
1005  (.NOT. regions(ireg)%levels(ilev)%edgeCells(6)%interact).OR. &
1006  (.NOT. regions(ireg)%levels(ilev)%edgeCells(10)%interact)) &
1007  grid%nghbor(3,1:nbour,6) = 0
1008 
1009 ! --- corner 7
1010  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(7)%interact).OR. &
1011  (.NOT. regions(ireg)%levels(ilev)%edgeCells(6)%interact).OR. &
1012  (.NOT. regions(ireg)%levels(ilev)%edgeCells(7)%interact).OR. &
1013  (.NOT. regions(ireg)%levels(ilev)%edgeCells(11)%interact)) &
1014  grid%nghbor(3,1:nbour,7) = 0
1015 
1016 ! --- corner 8
1017  IF ((.NOT. regions(ireg)%levels(ilev)%cornerCells(8)%interact).OR. &
1018  (.NOT. regions(ireg)%levels(ilev)%edgeCells(7)%interact).OR. &
1019  (.NOT. regions(ireg)%levels(ilev)%edgeCells(8)%interact).OR. &
1020  (.NOT. regions(ireg)%levels(ilev)%edgeCells(12)%interact)) &
1021  grid%nghbor(3,1:nbour,8) = 0
1022 
1023  ENDIF ! myProcid
1024  ENDDO ! iReg
1025 
1026 ! second step search for external corners
1027 
1028  DO ireg = 1,global%nRegions
1029  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1030  regions(ireg)%active==active) THEN ! on my processor
1031 
1032  grid => regions(ireg)%levels(ilev)%grid
1033 
1034  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
1035 
1036  DO ipatch=1,regions(ireg)%nPatches
1037  patch => regions(ireg)%levels(ilev)%patches(ipatch)
1038  lbound = patch%lbound
1039  bctype = patch%bcType
1040 
1041  CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
1042  ibeg,iend,jbeg,jend,kbeg,kend )
1043 
1044  IF ((bctype>=bc_inflow .AND. bctype<=bc_inflow +bc_range) .OR. &
1045  (bctype>=bc_outflow .AND. bctype<=bc_outflow +bc_range) .OR. &
1046  (bctype>=bc_slipwall .AND. bctype<=bc_slipwall +bc_range) .OR. &
1047  (bctype>=bc_noslipwall .AND. bctype<=bc_noslipwall+bc_range) .OR. &
1048  (bctype>=bc_farfield .AND. bctype<=bc_farfield +bc_range) .OR. &
1049  (bctype>=bc_injection .AND. bctype<=bc_injection +bc_range) .OR. &
1050  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
1051  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range)) THEN
1052  IF (lbound==1 .OR. lbound==2) THEN
1053  ijknode(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
1054  ijknode(2) = indijk(ibeg,jbeg,kend,inoff,ijnoff)
1055  ijknode(3) = indijk(ibeg,jend,kend,inoff,ijnoff)
1056  ijknode(4) = indijk(ibeg,jend,kbeg,inoff,ijnoff)
1057  ELSEIF (lbound==3 .OR. lbound==4) THEN
1058  ijknode(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
1059  ijknode(2) = indijk(ibeg,jbeg,kend,inoff,ijnoff)
1060  ijknode(3) = indijk(iend,jbeg,kend,inoff,ijnoff)
1061  ijknode(4) = indijk(iend,jbeg,kbeg,inoff,ijnoff)
1062  ELSEIF (lbound==5 .OR. lbound==6) THEN
1063  ijknode(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
1064  ijknode(2) = indijk(ibeg,jend,kbeg,inoff,ijnoff)
1065  ijknode(3) = indijk(iend,jend,kbeg,inoff,ijnoff)
1066  ijknode(4) = indijk(iend,jbeg,kbeg,inoff,ijnoff)
1067  ENDIF ! lbound
1068  DO ic = 1,grid%nCorns(ireg)
1069  IF (ijknode(1)==grid%ijkCorn(ic,ireg) .OR. &
1070  ijknode(2)==grid%ijkCorn(ic,ireg) .OR. &
1071  ijknode(3)==grid%ijkCorn(ic,ireg) .OR. &
1072  ijknode(4)==grid%ijkCorn(ic,ireg)) grid%nghbor(3,1:nbour,ic)= 2
1073  ENDDO
1074  ENDIF ! bc_external
1075  ENDDO ! iPatch
1076 
1077  ENDIF ! myProcid
1078  ENDDO ! iReg
1079 
1080 ! third step search for external corners
1081 
1082  DO ireg = 1,global%nRegions
1083  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1084  regions(ireg)%active==active) THEN ! on my processor
1085 
1086  grid => regions(ireg)%levels(ilev)%grid
1087 
1088  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
1089 
1090  DO ipatch=1,regions(ireg)%nPatches
1091  patch => regions(ireg)%levels(ilev)%patches(ipatch)
1092  lbound = patch%lbound
1093  bctype = patch%bcType
1094 
1095  CALL rflo_getpatchindicesnodes( regions(ireg),patch,ilev, &
1096  ibeg,iend,jbeg,jend,kbeg,kend )
1097 
1098  IF (patch%bcMotion == bc_external) THEN
1099  IF (lbound==1 .OR. lbound==2) THEN
1100  ijknode(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
1101  ijknode(2) = indijk(ibeg,jbeg,kend,inoff,ijnoff)
1102  ijknode(3) = indijk(ibeg,jend,kend,inoff,ijnoff)
1103  ijknode(4) = indijk(ibeg,jend,kbeg,inoff,ijnoff)
1104  ELSEIF (lbound==3 .OR. lbound==4) THEN
1105  ijknode(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
1106  ijknode(2) = indijk(ibeg,jbeg,kend,inoff,ijnoff)
1107  ijknode(3) = indijk(iend,jbeg,kend,inoff,ijnoff)
1108  ijknode(4) = indijk(iend,jbeg,kbeg,inoff,ijnoff)
1109  ELSEIF (lbound==5 .OR. lbound==6) THEN
1110  ijknode(1) = indijk(ibeg,jbeg,kbeg,inoff,ijnoff)
1111  ijknode(2) = indijk(ibeg,jend,kbeg,inoff,ijnoff)
1112  ijknode(3) = indijk(iend,jend,kbeg,inoff,ijnoff)
1113  ijknode(4) = indijk(iend,jbeg,kbeg,inoff,ijnoff)
1114  ENDIF ! lbound
1115  DO ic = 1,grid%nCorns(ireg)
1116  IF (ijknode(1)==grid%ijkCorn(ic,ireg) .OR. &
1117  ijknode(2)==grid%ijkCorn(ic,ireg) .OR. &
1118  ijknode(3)==grid%ijkCorn(ic,ireg) .OR. &
1119  ijknode(4)==grid%ijkCorn(ic,ireg)) grid%nghbor(3,1:nbour,ic)= 0
1120  ENDDO
1121  ENDIF ! bc_external
1122  ENDDO ! iPatch
1123 
1124 ! DO ic = 1,grid%nCorns(iReg)
1125 ! DO k=1,nbour
1126 ! ------- inhibitor
1127 ! IF (iReg==70) &
1128 ! ------- titan4
1129 ! IF (iReg==120) &
1130 ! write(*,*)iReg,ic,k,edgelen,grid%nghbor(1:3,k,ic)
1131 ! ENDDO
1132 ! ENDDO
1133 
1134  ENDIF ! myProcid
1135  ENDDO ! iReg
1136 
1137  goto 999
1138 
1139 ! finalize --------------------------------------------------------------------
1140 
1141 88 CONTINUE
1142 
1143  global%error = errfl
1144  CALL errorstop( global,err_allocate,__line__ )
1145 
1146 99 CONTINUE
1147 
1148  global%error = errfl
1149  CALL errorstop( global,err_deallocate,__line__ )
1150 
1151 999 CONTINUE
1152 
1153  CALL deregisterfunction( global )
1154 
1155 END SUBROUTINE rflo_mgframesrchneighbors
1156 
1157 
1158 !******************************************************************************
1159 !
1160 ! Purpose: correct six closest neighbors
1161 !
1162 ! Description: none.
1163 !
1164 ! Input: regions = data of current region.
1165 !
1166 ! Output: grid%nghbor = corrected neighbouring points identified
1167 !
1168 ! Notes: none
1169 !
1170 !******************************************************************************
1171 
1172 SUBROUTINE rflo_mgframecorrectneighbors( regions )
1173 
1174  USE modinterfaces, ONLY : rflo_getdimensphys, rflo_getnodeoffset
1175 
1176  IMPLICIT NONE
1177 #include "Indexing.h"
1178 
1179 ! ... parameters
1180  TYPE(t_region), POINTER :: regions(:)
1181 
1182 ! ... loop variables
1183  INTEGER :: i, j, k, ic, ireg, nc, nreg, lc, lreg
1184 
1185 ! ... local variables
1186  INTEGER :: ilev, bctype, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
1187  INTEGER :: ijknode(4), inoff, ijnoff, errfl
1188  REAL(RFREAL) :: edgelen, ds, du2, dumax
1189  REAL(RFREAL), POINTER :: xyz(:,:)
1190  REAL(RFREAL), ALLOCATABLE :: dist(:,:)
1191 
1192  TYPE(t_patch), POINTER :: patch
1193  TYPE(t_grid), POINTER :: grid
1194  TYPE(t_global), POINTER :: global
1195 
1196 !******************************************************************************
1197 
1198  global => regions(1)%global
1199 
1200  CALL registerfunction( global,'RFLO_MgFrameCorrectNeighbors',&
1201  'RFLO_ModMoveGridNconform2.F90' )
1202 
1203 ! search for six closest neighbours -------------------------------------------
1204 
1205  ALLOCATE( dist(global%moveGridRegNc,global%nRegions), stat=errfl )
1206  IF (errfl>0) goto 88
1207 
1208  ilev = 1
1209 
1210  DO ireg = 1,global%nRegions
1211  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1212  regions(ireg)%active==active) THEN ! on my processor
1213 
1214  grid => regions(ireg)%levels(ilev)%grid
1215 
1216  CALL rflo_getdimensphys( regions(ireg),ilev,ipcbeg,ipcend, &
1217  jpcbeg,jpcend,kpcbeg,kpcend )
1218  CALL rflo_getnodeoffset( regions(ireg),ilev,inoff,ijnoff )
1219 
1220  xyz => regions(ireg)%levels(ilev)%gridOld%xyz
1221 
1222 ! --- calculate the shortest cell edge
1223 
1224  edgelen = 1.e+30_rfreal
1225 
1226  DO k=kpcbeg,kpcend
1227  DO j=jpcbeg,jpcend
1228  DO i=ipcbeg,ipcend
1229  ijknode(1) = indijk(i ,j ,k ,inoff,ijnoff)
1230  ijknode(2) = indijk(i+1,j ,k ,inoff,ijnoff)
1231  ijknode(3) = indijk(i ,j+1,k ,inoff,ijnoff)
1232  ijknode(4) = indijk(i ,j ,k+1,inoff,ijnoff)
1233  ds = sqrt((xyz(xcoord,ijknode(2))-xyz(xcoord,ijknode(1)))**2+ &
1234  (xyz(ycoord,ijknode(2))-xyz(ycoord,ijknode(1)))**2+ &
1235  (xyz(zcoord,ijknode(2))-xyz(zcoord,ijknode(1)))**2)
1236  edgelen = min(edgelen,ds)
1237  ds = sqrt((xyz(xcoord,ijknode(3))-xyz(xcoord,ijknode(1)))**2+ &
1238  (xyz(ycoord,ijknode(3))-xyz(ycoord,ijknode(1)))**2+ &
1239  (xyz(zcoord,ijknode(3))-xyz(zcoord,ijknode(1)))**2)
1240  edgelen = min(edgelen,ds)
1241  ds = sqrt((xyz(xcoord,ijknode(4))-xyz(xcoord,ijknode(1)))**2+ &
1242  (xyz(ycoord,ijknode(4))-xyz(ycoord,ijknode(1)))**2+ &
1243  (xyz(zcoord,ijknode(4))-xyz(zcoord,ijknode(1)))**2)
1244  edgelen = min(edgelen,ds)
1245  ENDDO
1246  ENDDO
1247  ENDDO
1248 
1249  DO ic = 1,grid%nCorns(ireg)
1250  DO k = 1,global%moveGridNbour
1251  nc = grid%nghbor(1,k,ic)
1252  nreg = grid%nghbor(2,k,ic)
1253  dumax = -1.e+20_rfreal
1254 
1255  DO lreg = 1,global%nRegions
1256  DO lc = 1,grid%nCorns(lreg)
1257  dist(lc,lreg) = sqrt((grid%regCornOrig(xcoord,nc,nreg)- &
1258  grid%regCornOrig(xcoord,lc,lreg))**2 + &
1259  (grid%regCornOrig(ycoord,nc,nreg)- &
1260  grid%regCornOrig(ycoord,lc,lreg))**2 + &
1261  (grid%regCornOrig(zcoord,nc,nreg)- &
1262  grid%regCornOrig(zcoord,lc,lreg))**2)
1263 
1264  IF (dist(lc,lreg) < 0.1_rfreal*edgelen) THEN
1265  du2 = grid%regCornOld(xcoord,lc,lreg)**2 + &
1266  grid%regCornOld(ycoord,lc,lreg)**2 + &
1267  grid%regCornOld(zcoord,lc,lreg)**2
1268 
1269  IF ( du2 > dumax ) THEN
1270  dumax = du2
1271  grid%nghbor(1,k,ic) = lc
1272  grid%nghbor(2,k,ic) = lreg
1273  ENDIF ! duMax
1274  ENDIF ! dist
1275  ENDDO ! lc
1276  ENDDO ! lReg
1277  ENDDO ! k
1278  ENDDO ! ic
1279 
1280  ENDIF ! myProcid
1281  ENDDO ! iReg
1282 
1283 ! deallocate temporary arrays -------------------------------------------------
1284 
1285  DEALLOCATE( dist, stat=errfl ); IF (errfl>0) goto 99
1286 
1287  goto 999
1288 
1289 ! finalize --------------------------------------------------------------------
1290 
1291 88 CONTINUE
1292 
1293  global%error = errfl
1294  CALL errorstop( global,err_allocate,__line__ )
1295 
1296 99 CONTINUE
1297 
1298  global%error = errfl
1299  CALL errorstop( global,err_deallocate,__line__ )
1300 
1301 999 CONTINUE
1302 
1303  CALL deregisterfunction( global )
1304 
1305 END SUBROUTINE rflo_mgframecorrectneighbors
1306 
1307 !******************************************************************************
1308 !
1309 ! Purpose: move block corners by averaging over 6 closest neighbours
1310 !
1311 ! Description: none.
1312 !
1313 ! Input: regions = data of current region.
1314 !
1315 ! Output: region%levels%grid%regCorn = new block corners movement.
1316 !
1317 ! Notes: none
1318 !
1319 !******************************************************************************
1320 
1321 SUBROUTINE rflo_mgframemovecorners( regions )
1322 
1323  USE modtools, ONLY : isnan
1324  IMPLICIT NONE
1325 
1326 #include "Indexing.h"
1327 
1328 ! ... parameters
1329  TYPE(t_region), POINTER :: regions(:)
1330 
1331 ! ... loop variables
1332  INTEGER :: ireg, ico, k, l
1333 
1334 ! ... local variables
1335  INTEGER :: ilev, interior, ijkcorn, nbour, errfl
1336  INTEGER :: ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, inoff, ijnoff
1337  INTEGER, ALLOCATABLE :: nco(:), nreg(:)
1338  REAL(RFREAL) :: rdenom, amp(3), pow, sum
1339  REAL(RFREAL), ALLOCATABLE :: dist(:), wght(:)
1340 
1341  TYPE(t_grid), POINTER :: grid
1342  TYPE(t_global), POINTER :: global
1343 
1344 !******************************************************************************
1345 
1346  global => regions(1)%global
1347 
1348  CALL registerfunction( global,'RFLO_MgFrameMoveCorners',&
1349  'RFLO_ModMoveGridNconform2.F90' )
1350 
1351 ! move block corners ----------------------------------------------------------
1352 
1353  ilev = 1
1354  amp(1) = global%moveGridAmplifX
1355  amp(2) = global%moveGridAmplifY
1356  amp(3) = global%moveGridAmplifZ
1357  pow = global%moveGridPower
1358  nbour = global%moveGridNbour
1359 
1360  ALLOCATE( nco(nbour), stat=errfl ); IF (errfl>0) goto 88
1361  ALLOCATE( nreg(nbour), stat=errfl ); IF (errfl>0) goto 88
1362 
1363  ALLOCATE( dist(nbour), stat=errfl ); IF (errfl>0) goto 88
1364  ALLOCATE( wght(nbour), stat=errfl ); IF (errfl>0) goto 88
1365 
1366  DO ireg = 1,global%nRegions
1367  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1368  regions(ireg)%active==active) THEN ! on my processor
1369 
1370  grid => regions(ireg)%levels(ilev)%grid
1371 
1372  DO ico = 1,grid%nCorns(ireg)
1373  nco(1:nbour) = grid%nghbor(1,1:nbour,ico)
1374  nreg(1:nbour) = grid%nghbor(2,1:nbour,ico)
1375  interior = grid%nghbor(3,1 ,ico)
1376 
1377  IF (interior==1) THEN
1378  DO k = 1,nbour
1379  dist(k) = (grid%regCornOrig(xcoord,nco(k),nreg(k)) - &
1380  grid%regCornOrig(xcoord,ico,ireg))**2 + &
1381  (grid%regCornOrig(ycoord,nco(k),nreg(k)) - &
1382  grid%regCornOrig(ycoord,ico,ireg))**2 + &
1383  (grid%regCornOrig(zcoord,nco(k),nreg(k)) - &
1384  grid%regCornOrig(zcoord,ico,ireg))**2
1385  dist(k) = 1._rfreal/sqrt( dist(k) )**pow
1386  ENDDO
1387 
1388  sum = 0._rfreal
1389  DO l = 1,nbour
1390  sum = sum + dist(l)
1391  ENDDO
1392  rdenom = 1._rfreal/sum
1393 
1394  DO k = 1,nbour
1395  wght(k) = dist(k)*rdenom
1396 ! write(*,*)iReg,ico,k,nReg(k),nco(k),dist(k),wght(k)
1397  IF (isnan(wght(k))) &
1398  CALL errorstop( global,err_illegal_value,__line__, &
1399  'invalid weights for global frame motion')
1400  ENDDO
1401 
1402  sum = 0._rfreal
1403  DO l = 1,nbour
1404  sum = sum + wght(l)*grid%regCornOld(xcoord,nco(l),nreg(l))
1405  ENDDO
1406  grid%regCorn(xcoord,ico,ireg) = sum
1407 
1408  sum = 0._rfreal
1409  DO l = 1,nbour
1410  sum = sum + wght(l)*grid%regCornOld(ycoord,nco(l),nreg(l))
1411  ENDDO
1412  grid%regCorn(ycoord,ico,ireg) = sum
1413 
1414  sum = 0._rfreal
1415  DO l = 1,nbour
1416  sum = sum + wght(l)*grid%regCornOld(zcoord,nco(l),nreg(l))
1417  ENDDO
1418  grid%regCorn(zcoord,ico,ireg) = sum
1419 
1420  ENDIF ! interior
1421  ENDDO ! ico
1422  ENDIF ! myProcid
1423  ENDDO ! iReg
1424 
1425  DO ireg = 1,global%nRegions
1426  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1427  regions(ireg)%active==active) THEN ! on my processor
1428 
1429  grid => regions(ireg)%levels(ilev)%grid
1430 
1431  DO ico = 1,grid%nCorns(ireg)
1432  interior = grid%nghbor(3, 1, ico)
1433  IF (interior==1) THEN
1434  grid%regCornOld(xcoord,ico,ireg)=amp(1)*grid%regCorn(xcoord,ico,ireg)
1435  grid%regCornOld(ycoord,ico,ireg)=amp(2)*grid%regCorn(ycoord,ico,ireg)
1436  grid%regCornOld(zcoord,ico,ireg)=amp(3)*grid%regCorn(zcoord,ico,ireg)
1437 
1438  ijkcorn = grid%ijkCorn(ico,ireg)
1439  grid%xyz(xcoord,ijkcorn) = grid%regCorn(xcoord,ico,ireg)
1440  grid%xyz(ycoord,ijkcorn) = grid%regCorn(ycoord,ico,ireg)
1441  grid%xyz(zcoord,ijkcorn) = grid%regCorn(zcoord,ico,ireg)
1442  ENDIF
1443  ENDDO ! ico
1444 
1445  ENDIF ! myProcid
1446  ENDDO ! iReg
1447 
1448 ! deallocate temporary arrays
1449 
1450  DEALLOCATE( nco, stat=errfl ); IF (errfl>0) goto 99
1451  DEALLOCATE( nreg, stat=errfl ); IF (errfl>0) goto 99
1452 
1453  DEALLOCATE( dist, stat=errfl ); IF (errfl>0) goto 99
1454  DEALLOCATE( wght, stat=errfl ); IF (errfl>0) goto 99
1455 
1456  goto 999
1457 
1458 ! finalize --------------------------------------------------------------------
1459 
1460 88 CONTINUE
1461 
1462  global%error = errfl
1463  CALL errorstop( global,err_allocate,__line__ )
1464 
1465 99 CONTINUE
1466 
1467  global%error = errfl
1468  CALL errorstop( global,err_deallocate,__line__ )
1469 
1470 999 CONTINUE
1471 
1472  CALL deregisterfunction( global )
1473 
1474 END SUBROUTINE rflo_mgframemovecorners
1475 
1476 
1477 !******************************************************************************
1478 !
1479 ! Purpose: receive and distribute the deformations of surfaces
1480 ! in block-wise manner.
1481 !
1482 ! Description: none.
1483 !
1484 ! Input: regions = data of all grid regions.
1485 !
1486 ! Output: regions%levels%grid%xyz = deformations at the boundaries
1487 ! someMoved = parts of grid moved.
1488 !
1489 ! Notes: grid%xyz temporarily stores nodal displacements. The deformation
1490 ! is applied to the finest grid first.
1491 !
1492 !******************************************************************************
1493 
1494 SUBROUTINE rflo_mgframesurfaces( regions,someMoved,iType )
1495 
1496  USE modinterfaces, ONLY : rflo_getdeformation, rflo_arclengthbounds, &
1497  rflo_edgedeformation, rflo_boundarydeformation, &
1498  rflo_getnodeoffset, rflo_getpatchindicesnodes
1499  IMPLICIT NONE
1500 
1501 ! ... parameters
1502  LOGICAL :: somemoved
1503  INTEGER :: itype
1504 
1505  TYPE(t_region), POINTER :: regions(:)
1506 
1507 ! ... loop variables
1508  INTEGER :: ireg, iter, ipatch, i, j, k, ijkn
1509 
1510 ! ... local variables
1511  INTEGER :: ilev, bctype
1512  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, inoff, ijnoff
1513  TYPE(t_grid), POINTER :: grid, gridold
1514  TYPE(t_global), POINTER :: global
1515  TYPE(t_patch), POINTER :: patch
1516 
1517 !******************************************************************************
1518 
1519  global => regions(1)%global
1520 
1521  CALL registerfunction( global,'RFLO_MgFrameSurfaces',&
1522  'RFLO_ModMoveGridNconform2.F90' )
1523 
1524 ! move grid separately for each region ----------------------------------------
1525 
1526  somemoved = .false.
1527  ilev = 1
1528 
1529  DO ireg=1,global%nRegions
1530  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1531  regions(ireg)%active==active .AND. & ! on my processor
1532  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1533 
1534  grid => regions(ireg)%levels(ilev)%grid
1535  gridold => regions(ireg)%levels(ilev)%gridOld
1536  somemoved = .true.
1537 
1538 ! --- store the old grid
1539 
1540  gridold%indSvel = grid%indSvel
1541  gridold%ipc = grid%ipc
1542  gridold%jpc = grid%jpc
1543  gridold%kpc = grid%kpc
1544  gridold%xyz(:,:) = grid%xyz(:,:)
1545  gridold%si(:,:) = grid%si(:,:)
1546  gridold%sj(:,:) = grid%sj(:,:)
1547  gridold%sk(:,:) = grid%sk(:,:)
1548  gridold%vol(:) = grid%vol(:)
1549 
1550 ! --- calculate arclengths between boundaries
1551 
1552  CALL rflo_arclengthbounds( regions(ireg),gridold%xyzOld, &
1553  grid%arcLen12,grid%arcLen34,grid%arcLen56 )
1554 
1555 ! --- get the boundary deformations
1556 
1557  CALL rflo_getdeformation( regions(ireg),grid%boundMoved,grid%xyz )
1558 
1559  grid%xyzOld(:,:) = grid%xyz(:,:)
1560 
1561  ENDIF ! region on this processor and active, grid moving
1562  ENDDO ! iReg
1563 
1564 ! broadcast and compute block corners deformation
1565 
1566  iter = 1
1567  CALL rflo_mgframebroadcast( regions,1,iter )
1568  CALL rflo_mgframecorrectneighbors( regions )
1569  CALL rflo_mgframemovecorners( regions )
1570 
1571  DO iter = 2,10
1572  CALL rflo_mgframebroadcast( regions,1,iter )
1573  CALL rflo_mgframemovecorners( regions )
1574  ENDDO
1575 
1576  DO ireg=1,global%nRegions
1577  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
1578  regions(ireg)%active==active .AND. & ! on my processor
1579  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
1580 
1581  grid => regions(ireg)%levels(ilev)%grid
1582  gridold => regions(ireg)%levels(ilev)%gridOld
1583 
1584 ! --- calculate deformations at remaining edges
1585 
1586 ! CALL RFLO_MgFrameEdgesO( regions(iReg),iType,grid%boundMoved, &
1587 ! grid%allExternal,grid%edgeMoved,grid%arcLen12, &
1588 ! grid%arcLen34,grid%arcLen56,gridOld%xyzOld,grid%xyz )
1589  CALL rflo_mgframeedges( regions(ireg),grid%edgeMoved, &
1590  gridold%xyzOld,grid%xyz )
1591 
1592  CALL rflo_mgframerestoreexternal( regions(ireg) )
1593 
1594 ! --- calculate deformations at remaining boundaries
1595 
1596  IF (itype==1) THEN
1597 ! CALL RFLO_MgFrameBndDeformation0( regions(iReg),grid%boundMoved, &
1598 ! grid%edgeMoved,grid%arcLen12, &
1599 ! grid%arcLen34,grid%arcLen56, &
1600 ! gridOld%xyzOld,grid%xyz )
1601  CALL rflo_mgframebnddeformation( regions(ireg),gridold%xyzOld,grid%xyz )
1602 
1603  ELSE ! iType
1604  CALL rflo_boundarydeformation( regions(ireg),grid%boundMoved, &
1605  grid%edgeMoved,grid%arcLen12, &
1606  grid%arcLen34,grid%arcLen56, &
1607  gridold%xyzOld,grid%xyz )
1608  ENDIF ! iType
1609 ! CALL RFLO_MgFrameRestoreExternal( regions(iReg) )
1610 
1611  ENDIF ! region on this processor and active, grid moving
1612  ENDDO ! iReg
1613 
1614 ! finalize --------------------------------------------------------------------
1615 
1616  CALL deregisterfunction( global )
1617 
1618 END SUBROUTINE rflo_mgframesurfaces
1619 
1620 
1621 !******************************************************************************
1622 !
1623 ! Purpose: restore deformation of solid surfaces from genx at given patches.
1624 !
1625 ! Description: none.
1626 !
1627 ! Input: region = data of current region.
1628 !
1629 ! Output: regions%levels%grid%xyz = deformations at the boundaries restored
1630 !
1631 ! Notes: grid%xyz temporarily stores nodal displacements. The 'untouched'
1632 ! deformation from genx has been saved in grid%xyzOld.
1633 !
1634 !******************************************************************************
1635 
1636 SUBROUTINE rflo_mgframerestoreexternal( region )
1637 
1638  USE modinterfaces, ONLY : rflo_getnodeoffset, rflo_getpatchindicesnodes
1639  IMPLICIT NONE
1640 #include "Indexing.h"
1641 
1642 ! ... parameters
1643  TYPE(t_region) :: region
1644 
1645 ! ... loop variables
1646  INTEGER :: ireg, ipatch, i, j, k
1647 
1648 ! ... local variables
1649  INTEGER :: ilev, ijkn, lbound
1650  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, inoff, ijnoff
1651  TYPE(t_grid), POINTER :: grid
1652  TYPE(t_global), POINTER :: global
1653  TYPE(t_patch), POINTER :: patch
1654 
1655 !******************************************************************************
1656 
1657  global => region%global
1658 
1659  CALL registerfunction( global,'RFLO_MgFrameRestoreExternal',&
1660  'RFLO_ModMoveGridNconform2.F90' )
1661 
1662 ! parameters and pointers -----------------------------------------------------
1663 
1664  ilev = 1
1665  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
1666 
1667  grid => region%levels(ilev)%grid
1668 
1669 ! restore displacements
1670 
1671  DO ipatch=1,region%nPatches
1672  patch => region%levels(ilev)%patches(ipatch)
1673  lbound = patch%lbound
1674 
1675  IF (patch%bcMotion == bc_external .AND. &
1676  (grid%allExternal(lbound).EQV..false.)) THEN
1677 ! IF (patch%bcMotion == BC_EXTERNAL) THEN
1678  CALL rflo_getpatchindicesnodes( region,patch,ilev, &
1679  ibeg,iend,jbeg,jend,kbeg,kend )
1680 
1681  DO k=kbeg,kend
1682  DO j=jbeg,jend
1683  DO i=ibeg,iend
1684  ijkn = indijk(i,j,k,inoff,ijnoff)
1685  grid%xyz(xcoord,ijkn) = grid%xyzOld(xcoord,ijkn)
1686  grid%xyz(ycoord,ijkn) = grid%xyzOld(ycoord,ijkn)
1687  grid%xyz(zcoord,ijkn) = grid%xyzOld(zcoord,ijkn)
1688  ENDDO
1689  ENDDO
1690  ENDDO
1691 
1692  ENDIF ! external BC
1693  ENDDO ! iPatch
1694 
1695 ! finalize --------------------------------------------------------------------
1696 
1697  CALL deregisterfunction( global )
1698 
1699 END SUBROUTINE rflo_mgframerestoreexternal
1700 
1701 !******************************************************************************
1702 !
1703 ! Purpose: calculate node displacements on those edges whose end points have
1704 ! moved, but the associated boundaries were not updated yet (finest
1705 ! grid only).
1706 !
1707 ! Description: points along an edge are shifted using 1-D linear transfinite
1708 ! interpolation (TFI).
1709 !
1710 ! Input: region = grid dimensions
1711 ! boundMoved = flag for boundaries of a region which have moved
1712 ! arcLen12 = arclength between i=const. boundaries for each j, k
1713 ! arcLen34 = arclength between j=const. boundaries for each k, i
1714 ! arcLen56 = arclength between k=const. boundaries for each i, j
1715 ! xyzOld = grid from previous time step.
1716 !
1717 ! Output: edgeMoved = flag if discretization at an edge was changed
1718 ! dNode = updated deformations at edges.
1719 !
1720 ! Notes: variable dNode contains the whole 3-D field.
1721 !
1722 !******************************************************************************
1723 
1724 SUBROUTINE rflo_mgframeedgeso( region,iType,boundMoved,allExternal,edgeMoved, &
1725  arclen12,arclen34,arclen56,xyzold,dnode )
1726 
1727  USE modinterfaces, ONLY : rflo_getnodeoffset, rflo_getdimensphysnodes, &
1728  rflo_tfint1d
1729  IMPLICIT NONE
1730 
1731 #include "Indexing.h"
1732 
1733 ! ... parameters
1734  LOGICAL :: boundmoved(6), allexternal(6), edgemoved(12)
1735 
1736  INTEGER :: itype
1737  REAL(RFREAL), POINTER :: arclen12(:,:), arclen34(:,:), arclen56(:,:)
1738  REAL(RFREAL), POINTER :: dnode(:,:), xyzold(:,:)
1739 
1740  TYPE(t_region) :: region
1741 
1742 ! ... loop variables
1743  INTEGER :: iedge, ind
1744 
1745 ! ... local variables
1746  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend, l1c, l2c
1747  INTEGER :: indbeg, indend, ijkn, ijkn1, ijknbeg, ijknend, inoff, ijnoff
1748  INTEGER :: switch(12,11), intertype, iedgeglo
1749 
1750  REAL(RFREAL) :: arclen, ds, s, dn(3), dnbeg(3), dnend(3)
1751  LOGICAL :: interact
1752 
1753 !******************************************************************************
1754 
1755  CALL registerfunction( region%global,'RFLO_MgFrameEdgesO',&
1756  'RFLO_ModMoveGridNconform2.F90' )
1757 
1758 ! get dimensions --------------------------------------------------------------
1759 
1760  ilev = 1
1761  CALL rflo_getdimensphysnodes( region,ilev,ipnbeg,ipnend, &
1762  jpnbeg,jpnend,kpnbeg,kpnend )
1763  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
1764 
1765 ! set edge switch -------------------------------------------------------------
1766 ! switch(:,1) = begins at boundary
1767 ! switch(:,2) = ends on boundary
1768 ! switch(:,3) = right boundary
1769 ! switch(:,4) = left boundary
1770 ! switch(:,5) = direction (from-to boundary)
1771 ! switch(:,6) = start index
1772 ! switch(:,7) = end index
1773 ! switch(:,8) = constant index in 1st direction
1774 ! switch(:,9) = constant index in 2nd direction
1775 ! switch(:,10) = start corner number
1776 ! switch(:,11) = end corner number
1777 
1778  switch( 1,:) = (/5, 6, 1, 3, 56, kpnbeg, kpnend, ipnbeg, jpnbeg, 1, 2/)
1779  switch( 2,:) = (/3, 4, 1, 6, 34, jpnbeg, jpnend, kpnend, ipnbeg, 2, 3/)
1780  switch( 3,:) = (/5, 6, 1, 4, 56, kpnbeg, kpnend, ipnbeg, jpnend, 4, 3/)
1781  switch( 4,:) = (/3, 4, 1, 5, 34, jpnbeg, jpnend, kpnbeg, ipnbeg, 1, 4/)
1782  switch( 5,:) = (/5, 6, 2, 3, 56, kpnbeg, kpnend, ipnend, jpnbeg, 5, 6/)
1783  switch( 6,:) = (/3, 4, 2, 6, 34, jpnbeg, jpnend, kpnend, ipnend, 6, 7/)
1784  switch( 7,:) = (/5, 6, 2, 4, 56, kpnbeg, kpnend, ipnend, jpnend, 8, 7/)
1785  switch( 8,:) = (/3, 4, 2, 5, 34, jpnbeg, jpnend, kpnbeg, ipnend, 5, 8/)
1786  switch( 9,:) = (/1, 2, 3, 5, 12, ipnbeg, ipnend, jpnbeg, kpnbeg, 1, 5/)
1787  switch(10,:) = (/1, 2, 3, 6, 12, ipnbeg, ipnend, jpnbeg, kpnend, 2, 6/)
1788  switch(11,:) = (/1, 2, 4, 5, 12, ipnbeg, ipnend, jpnend, kpnbeg, 4, 8/)
1789  switch(12,:) = (/1, 2, 4, 6, 12, ipnbeg, ipnend, jpnend, kpnend, 3, 7/)
1790 
1791 ! edge movement flag ----------------------------------------------------------
1792 
1793  edgemoved(:) = .false.
1794 
1795  IF (itype/=1) THEN
1796  IF (boundmoved(1) .AND. allexternal(1)) THEN
1797  edgemoved( 1) = .true.; edgemoved( 2) = .true.
1798  edgemoved( 3) = .true.; edgemoved( 4) = .true.
1799  ENDIF
1800  IF (boundmoved(2) .AND. allexternal(2)) THEN
1801  edgemoved( 5) = .true.; edgemoved( 6) = .true.
1802  edgemoved( 7) = .true.; edgemoved( 8) = .true.
1803  ENDIF
1804  IF (boundmoved(3) .AND. allexternal(3)) THEN
1805  edgemoved( 1) = .true.; edgemoved( 5) = .true.
1806  edgemoved( 9) = .true.; edgemoved(10) = .true.
1807  ENDIF
1808  IF (boundmoved(4) .AND. allexternal(4)) THEN
1809  edgemoved( 3) = .true.; edgemoved( 7) = .true.
1810  edgemoved(11) = .true.; edgemoved(12) = .true.
1811  ENDIF
1812  IF (boundmoved(5) .AND. allexternal(5)) THEN
1813  edgemoved( 4) = .true.; edgemoved( 8) = .true.
1814  edgemoved( 9) = .true.; edgemoved(11) = .true.
1815  ENDIF
1816  IF (boundmoved(6) .AND. allexternal(6)) THEN
1817  edgemoved( 2) = .true.; edgemoved( 6) = .true.
1818  edgemoved(10) = .true.; edgemoved(12) = .true.
1819  ENDIF
1820  ENDIF ! iType
1821 
1822 ! loop over all 12 edges ------------------------------------------------------
1823 
1824  DO iedge=1,12
1825  IF (.NOT.edgemoved(iedge)) THEN
1826 
1827  edgemoved(iedge) = .true.
1828 
1829  ds = 0._rfreal
1830  indbeg = switch(iedge,6)
1831  indend = switch(iedge,7)
1832  l1c = switch(iedge,8)
1833  l2c = switch(iedge,9)
1834 
1835  iedgeglo = iedge
1836  IF (iedge==11) iedgeglo=12
1837  IF (iedge==12) iedgeglo=11
1838  interact = region%levels(ilev)%edgeCells(iedgeglo)%interact
1839  intertype = region%levels(ilev)%edgeCells(iedgeglo)%interType
1840 
1841  IF (((region%levels(ilev)%grid%nghbor(3,1,switch(iedge,10))==1 .OR. &
1842  region%levels(ilev)%grid%nghbor(3,1,switch(iedge,11))==1) .AND. &
1843  ((interact .EQV. .true.) .AND. (intertype==edge_interact_full))) &
1844  .OR. &
1845  region%levels(ilev)%grid%nghbor(3,1,switch(iedge,10))==2 .OR. &
1846  region%levels(ilev)%grid%nghbor(3,1,switch(iedge,11))==2) THEN
1847 
1848 ! IF (region%levels(iLev)%grid%nghbor(3,1,switch(iEdge,10))==1 .OR. &
1849 ! region%levels(iLev)%grid%nghbor(3,1,switch(iEdge,11))==1 .OR. &
1850 ! region%levels(iLev)%grid%nghbor(3,1,switch(iEdge,10))==2 .OR. &
1851 ! region%levels(iLev)%grid%nghbor(3,1,switch(iEdge,11))==2) THEN
1852 
1853  DO ind=indbeg+1,indend-1
1854  IF (switch(iedge,5) == 12) THEN
1855  ijkn = indijk(ind ,l1c,l2c,inoff,ijnoff)
1856  ijkn1 = indijk(ind-1 ,l1c,l2c,inoff,ijnoff)
1857  ijknbeg = indijk(indbeg,l1c,l2c,inoff,ijnoff)
1858  ijknend = indijk(indend,l1c,l2c,inoff,ijnoff)
1859  arclen = arclen12(l1c,l2c)
1860  dnbeg(:) = dnode(:,ijknbeg)
1861  dnend(:) = dnode(:,ijknend)
1862  ELSE IF (switch(iedge,5) == 34) THEN
1863  ijkn = indijk(l2c,ind ,l1c,inoff,ijnoff)
1864  ijkn1 = indijk(l2c,ind-1 ,l1c,inoff,ijnoff)
1865  ijknbeg = indijk(l2c,indbeg,l1c,inoff,ijnoff)
1866  ijknend = indijk(l2c,indend,l1c,inoff,ijnoff)
1867  arclen = arclen34(l1c,l2c)
1868  dnbeg(:) = dnode(:,ijknbeg)
1869  dnend(:) = dnode(:,ijknend)
1870  ELSE IF (switch(iedge,5) == 56) THEN
1871  ijkn = indijk(l1c,l2c,ind ,inoff,ijnoff)
1872  ijkn1 = indijk(l1c,l2c,ind-1 ,inoff,ijnoff)
1873  ijknbeg = indijk(l1c,l2c,indbeg,inoff,ijnoff)
1874  ijknend = indijk(l1c,l2c,indend,inoff,ijnoff)
1875  arclen = arclen56(l1c,l2c)
1876  dnbeg(:) = dnode(:,ijknbeg)
1877  dnend(:) = dnode(:,ijknend)
1878  ENDIF
1879  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
1880  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
1881  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
1882  s = ds/arclen
1883 
1884  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
1885  dnode(:,ijkn) = dn(:)
1886  ENDDO ! i
1887  ENDIF ! nghbor
1888  ENDIF ! edgeMoved
1889  ENDDO ! iEdge
1890 
1891 ! finalize --------------------------------------------------------------------
1892 
1893  CALL deregisterfunction( region%global )
1894 
1895 END SUBROUTINE rflo_mgframeedgeso
1896 
1897 !******************************************************************************
1898 !
1899 ! Purpose: calculate node displacements on those patch edges whose end points
1900 ! both are or one of them is interior point.
1901 !
1902 ! Description: points along patch edge are shifted using 1-D linear transfinite
1903 ! interpolation (TFI).
1904 !
1905 ! Input: region = grid dimensions
1906 ! boundMoved = flag for boundaries of a region which have moved
1907 ! xyzOld = grid from previous time step.
1908 !
1909 ! Output: edgeMoved = flag if discretization at an edge was changed
1910 ! dNode = updated deformations at edges.
1911 !
1912 ! Notes: variable dNode contains the whole 3-D field.
1913 !
1914 !******************************************************************************
1915 
1916 SUBROUTINE rflo_mgframeedges( region,edgeMoved,xyzOld,dNode )
1917 
1918  USE modinterfaces, ONLY : rflo_getnodeoffset, rflo_getpatchindicesnodes, &
1919  rflo_tfint1d
1920  IMPLICIT NONE
1921 
1922 #include "Indexing.h"
1923 
1924 ! ... parameters
1925  TYPE(t_region) :: region
1926  LOGICAL :: edgemoved(12)
1927  REAL(RFREAL), POINTER :: dnode(:,:), xyzold(:,:)
1928 
1929 ! ... loop variables
1930  INTEGER :: ipedge, ind, ipatch, ic
1931 
1932 ! ... local variables
1933  INTEGER :: ilev, ibeg, iend, jbeg, jend, kbeg, kend, ib, ie, jb, je , kb, ke
1934  INTEGER :: indbeg, indend, ijkn, ijkn1, ijknbeg, ijknend, inoff, ijnoff
1935  INTEGER :: lbound, intb, inte, ireg, iedge, intertype, ijktest, iset
1936 
1937  REAL(RFREAL) :: arclen, ds, s, dn(3), dnbeg(3), dnend(3), eps
1938  TYPE(t_patch), POINTER :: patch
1939  TYPE(t_grid), POINTER :: grid
1940 
1941 !******************************************************************************
1942 
1943  CALL registerfunction( region%global,'RFLO_MgFrameEdges',&
1944  'RFLO_ModMoveGridNconform2.F90' )
1945 
1946 ! get local parameters --------------------------------------------------------
1947 
1948  eps = epsilon( 1._rfreal )
1949 
1950 ! get dimensions and pointers -------------------------------------------------
1951 
1952  ireg = region%iRegionGlobal
1953  ilev = 1
1954  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
1955 
1956  grid => region%levels(ilev)%grid
1957 
1958 ! edge movement flag ----------------------------------------------------------
1959 
1960  edgemoved(:) = .true.
1961 
1962 ! loop over all patch edges ---------------------------------------------------
1963 
1964  DO ipatch=1,region%nPatches
1965  patch => region%levels(ilev)%patches(ipatch)
1966  lbound = patch%lbound
1967 
1968  CALL rflo_getpatchindicesnodes( region,patch,ilev, &
1969  ibeg,iend,jbeg,jend,kbeg,kend )
1970 
1971  IF (patch%bcMotion == bc_external) goto 777
1972  DO ipedge = 1,4
1973 
1974  IF (lbound==1 .OR. lbound==2) THEN
1975  IF (ipedge==1) THEN
1976  ib = ibeg
1977  ie = ibeg
1978  jb = jbeg
1979  je = jbeg
1980  kb = kbeg
1981  ke = kend
1982  indbeg = kb
1983  indend = ke
1984  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
1985  ijknend = indijk(ie,je,ke,inoff,ijnoff)
1986  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
1987  intb = 1
1988  inte = 1
1989  IF (lbound==1) THEN
1990  iedge = 1
1991  ELSE
1992  iedge = 5
1993  ENDIF
1994  intertype = region%levels(ilev)%edgeCells(iedge)%interType
1995  DO ic = 1,grid%nCorns(ireg)
1996  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
1997  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
1998  ENDDO
1999  patch%position(1) = intb
2000  patch%position(2) = inte
2001 
2002  iset = 0
2003  DO ind=indbeg+1,indend-1
2004  ijkn = indijk(ibeg,jbeg,ind ,inoff,ijnoff)
2005  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2006  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2007  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2008  iset = 1
2009  EXIT
2010  ENDIF
2011  ENDDO
2012 
2013  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2014  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2015  .OR. &
2016 ! (intb==2 .OR. inte==2)) THEN
2017  (intb==2 .OR. inte==2) &
2018  .OR. &
2019  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2020  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2021  100._rfreal*eps)) .AND. (iset==0)) THEN
2022 
2023  dnbeg(:) = dnode(:,ijknbeg)
2024  dnend(:) = dnode(:,ijknend)
2025 
2026  arclen = 0._rfreal
2027  DO ind=indbeg+1,indend
2028  ijkn = indijk(ibeg,jbeg,ind ,inoff,ijnoff)
2029  ijkn1 = indijk(ibeg,jbeg,ind-1,inoff,ijnoff)
2030  arclen = arclen + &
2031  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2032  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2033  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2034  ENDDO
2035  ds = 0._rfreal
2036  DO ind=indbeg+1,indend-1
2037  ijkn = indijk(ibeg,jbeg,ind ,inoff,ijnoff)
2038  ijkn1 = indijk(ibeg,jbeg,ind-1,inoff,ijnoff)
2039  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2040  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2041  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2042  s = ds/arclen
2043  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2044  dnode(:,ijkn) = dn(:)
2045  ENDDO
2046  ENDIF
2047  ELSEIF (ipedge==2) THEN
2048  ib = ibeg
2049  ie = ibeg
2050  jb = jbeg
2051  je = jend
2052  kb = kend
2053  ke = kend
2054  indbeg = jb
2055  indend = je
2056  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2057  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2058  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2059  intb = 1
2060  inte = 1
2061  IF (lbound==1) THEN
2062  iedge = 2
2063  ELSE
2064  iedge = 6
2065  ENDIF
2066  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2067  DO ic = 1,grid%nCorns(ireg)
2068  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2069  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2070 ! IF (region%iRegionGlobal==70) write(*,*)iReg,ic, &
2071 ! grid%ijkCorn(ic,iReg),ijkNBeg,ijkNEnd,intb,inte, &
2072 ! grid%nghbor(3,1,ic)
2073  ENDDO
2074  patch%position(2) = intb
2075  patch%position(3) = inte
2076 
2077  iset = 0
2078  DO ind=indbeg+1,indend-1
2079  ijkn = indijk(ibeg,ind ,kend,inoff,ijnoff)
2080  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2081  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2082  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2083  iset = 1
2084  EXIT
2085  ENDIF
2086  ENDDO
2087 
2088  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2089  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2090  .OR. &
2091 ! (intb==2 .OR. inte==2)) THEN
2092  (intb==2 .OR. inte==2) &
2093  .OR. &
2094  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2095  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2096  100._rfreal*eps)) .AND. (iset==0)) THEN
2097 
2098  dnbeg(:) = dnode(:,ijknbeg)
2099  dnend(:) = dnode(:,ijknend)
2100 
2101  arclen = 0._rfreal
2102  DO ind=indbeg+1,indend
2103  ijkn = indijk(ibeg,ind ,kend,inoff,ijnoff)
2104  ijkn1 = indijk(ibeg,ind-1,kend,inoff,ijnoff)
2105  arclen = arclen + &
2106  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2107  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2108  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2109  ENDDO
2110  ds = 0._rfreal
2111  DO ind=indbeg+1,indend-1
2112  ijkn = indijk(ibeg,ind ,kend,inoff,ijnoff)
2113  ijkn1 = indijk(ibeg,ind-1,kend,inoff,ijnoff)
2114  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2115  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2116  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2117  s = ds/arclen
2118  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2119  dnode(:,ijkn) = dn(:)
2120  ENDDO
2121  ENDIF
2122  ELSEIF (ipedge==3) THEN
2123  ib = ibeg
2124  ie = ibeg
2125  jb = jend
2126  je = jend
2127  kb = kbeg
2128  ke = kend
2129  indbeg = kb
2130  indend = ke
2131  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2132  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2133  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2134  intb = 1
2135  inte = 1
2136  IF (lbound==1) THEN
2137  iedge = 3
2138  ELSE
2139  iedge = 7
2140  ENDIF
2141  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2142  DO ic = 1,grid%nCorns(ireg)
2143  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2144  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2145  ENDDO
2146  patch%position(3) = inte
2147  patch%position(4) = intb
2148 
2149  iset = 0
2150  DO ind=indbeg+1,indend-1
2151  ijkn = indijk(ibeg,jend,ind ,inoff,ijnoff)
2152  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2153  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2154  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2155  iset = 1
2156  EXIT
2157  ENDIF
2158  ENDDO
2159 
2160  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2161  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2162  .OR. &
2163 ! (intb==2 .OR. inte==2)) THEN
2164  (intb==2 .OR. inte==2) &
2165  .OR. &
2166  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2167  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2168  100._rfreal*eps)) .AND. (iset==0)) THEN
2169 
2170  dnbeg(:) = dnode(:,ijknbeg)
2171  dnend(:) = dnode(:,ijknend)
2172 
2173  arclen = 0._rfreal
2174  DO ind=indbeg+1,indend
2175  ijkn = indijk(ibeg,jend,ind ,inoff,ijnoff)
2176  ijkn1 = indijk(ibeg,jend,ind-1,inoff,ijnoff)
2177  arclen = arclen + &
2178  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2179  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2180  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2181  ENDDO
2182  ds = 0._rfreal
2183  DO ind=indbeg+1,indend-1
2184  ijkn = indijk(ibeg,jend,ind ,inoff,ijnoff)
2185  ijkn1 = indijk(ibeg,jend,ind-1,inoff,ijnoff)
2186  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2187  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2188  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2189  s = ds/arclen
2190  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2191  dnode(:,ijkn) = dn(:)
2192  ENDDO
2193  ENDIF
2194  ELSEIF (ipedge==4) THEN
2195  ib = ibeg
2196  ie = ibeg
2197  jb = jbeg
2198  je = jend
2199  kb = kbeg
2200  ke = kbeg
2201  indbeg = jb
2202  indend = je
2203  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2204  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2205  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2206  intb = 1
2207  inte = 1
2208  IF (lbound==1) THEN
2209  iedge = 4
2210  ELSE
2211  iedge = 8
2212  ENDIF
2213  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2214  DO ic = 1,grid%nCorns(ireg)
2215  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2216  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2217  ENDDO
2218  patch%position(4) = inte
2219  patch%position(1) = intb
2220 
2221  iset = 0
2222  DO ind=indbeg+1,indend-1
2223  ijkn = indijk(ibeg,ind ,kbeg,inoff,ijnoff)
2224  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2225  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2226  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2227  iset = 1
2228  EXIT
2229  ENDIF
2230  ENDDO
2231 
2232  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2233  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2234  .OR. &
2235 ! (intb==2 .OR. inte==2)) THEN
2236  (intb==2 .OR. inte==2) &
2237  .OR. &
2238  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2239  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2240  100._rfreal*eps)) .AND. (iset==0)) THEN
2241 
2242  dnbeg(:) = dnode(:,ijknbeg)
2243  dnend(:) = dnode(:,ijknend)
2244 
2245  arclen = 0._rfreal
2246  DO ind=indbeg+1,indend
2247  ijkn = indijk(ibeg,ind ,kbeg,inoff,ijnoff)
2248  ijkn1 = indijk(ibeg,ind-1,kbeg,inoff,ijnoff)
2249  arclen = arclen + &
2250  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2251  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2252  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2253  ENDDO
2254  ds = 0._rfreal
2255  DO ind=indbeg+1,indend-1
2256  ijkn = indijk(ibeg,ind ,kbeg,inoff,ijnoff)
2257  ijkn1 = indijk(ibeg,ind-1,kbeg,inoff,ijnoff)
2258  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2259  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2260  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2261  s = ds/arclen
2262  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2263  dnode(:,ijkn) = dn(:)
2264 ! IF (region%iRegionGlobal==10 .AND. lbound==2) &
2265 ! write(*,*)ind,s,arcLen,dNBeg,dNEnd
2266  ENDDO
2267  ENDIF ! intb
2268  ENDIF ! ipEdge
2269  ENDIF ! lbound
2270 
2271  IF (lbound==3 .OR. lbound==4) THEN
2272  IF (ipedge==1) THEN
2273  ib = ibeg
2274  ie = iend
2275  jb = jbeg
2276  je = jbeg
2277  kb = kbeg
2278  ke = kbeg
2279  indbeg = ib
2280  indend = ie
2281  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2282  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2283  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2284  intb = 1
2285  inte = 1
2286  IF (lbound==3) THEN
2287  iedge = 9
2288  ELSE
2289  iedge = 12
2290  ENDIF
2291  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2292  DO ic = 1,grid%nCorns(ireg)
2293  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2294  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2295  ENDDO
2296  patch%position(1) = intb
2297  patch%position(2) = inte
2298 
2299  iset = 0
2300  DO ind=indbeg+1,indend-1
2301  ijkn = indijk(ind ,jbeg,kbeg,inoff,ijnoff)
2302  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2303  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2304  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2305  iset = 1
2306  EXIT
2307  ENDIF
2308  ENDDO
2309 
2310  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2311  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2312  .OR. &
2313 ! (intb==2 .OR. inte==2)) THEN
2314  (intb==2 .OR. inte==2) &
2315  .OR. &
2316  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2317  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2318  100._rfreal*eps)) .AND. (iset==0)) THEN
2319 
2320  dnbeg(:) = dnode(:,ijknbeg)
2321  dnend(:) = dnode(:,ijknend)
2322 
2323  arclen = 0._rfreal
2324  DO ind=indbeg+1,indend
2325  ijkn = indijk(ind ,jbeg,kbeg,inoff,ijnoff)
2326  ijkn1 = indijk(ind-1,jbeg,kbeg,inoff,ijnoff)
2327  arclen = arclen + &
2328  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2329  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2330  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2331  ENDDO
2332  ds = 0._rfreal
2333  DO ind=indbeg+1,indend-1
2334  ijkn = indijk(ind ,jbeg,kbeg,inoff,ijnoff)
2335  ijkn1 = indijk(ind-1,jbeg,kbeg,inoff,ijnoff)
2336  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2337  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2338  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2339  s = ds/arclen
2340  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2341  dnode(:,ijkn) = dn(:)
2342  ENDDO
2343  ENDIF
2344  ELSEIF (ipedge==2) THEN
2345  ib = iend
2346  ie = iend
2347  jb = jbeg
2348  je = jbeg
2349  kb = kbeg
2350  ke = kend
2351  indbeg = kb
2352  indend = ke
2353  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2354  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2355  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2356  intb = 1
2357  inte = 1
2358  IF (lbound==3) THEN
2359  iedge = 5
2360  ELSE
2361  iedge = 7
2362  ENDIF
2363  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2364  DO ic = 1,grid%nCorns(ireg)
2365  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2366  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2367  ENDDO
2368  patch%position(2) = intb
2369  patch%position(3) = inte
2370 
2371  iset = 0
2372  DO ind=indbeg+1,indend-1
2373  ijkn = indijk(iend,jbeg,ind ,inoff,ijnoff)
2374  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2375  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2376  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2377  iset = 1
2378  EXIT
2379  ENDIF
2380  ENDDO
2381 
2382  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2383  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2384  .OR. &
2385 ! (intb==2 .OR. inte==2)) THEN
2386  (intb==2 .OR. inte==2) &
2387  .OR. &
2388  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2389  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2390  100._rfreal*eps)) .AND. (iset==0)) THEN
2391 
2392  dnbeg(:) = dnode(:,ijknbeg)
2393  dnend(:) = dnode(:,ijknend)
2394 
2395  arclen = 0._rfreal
2396  DO ind=indbeg+1,indend
2397  ijkn = indijk(iend,jbeg,ind ,inoff,ijnoff)
2398  ijkn1 = indijk(iend,jbeg,ind-1,inoff,ijnoff)
2399  arclen = arclen + &
2400  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2401  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2402  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2403  ENDDO
2404  ds = 0._rfreal
2405  DO ind=indbeg+1,indend-1
2406  ijkn = indijk(iend,jbeg,ind ,inoff,ijnoff)
2407  ijkn1 = indijk(iend,jbeg,ind-1,inoff,ijnoff)
2408  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2409  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2410  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2411  s = ds/arclen
2412  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2413  dnode(:,ijkn) = dn(:)
2414  ENDDO
2415  ENDIF
2416  ELSEIF (ipedge==3) THEN
2417  ib = ibeg
2418  ie = iend
2419  jb = jbeg
2420  je = jbeg
2421  kb = kend
2422  ke = kend
2423  indbeg = ib
2424  indend = ie
2425  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2426  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2427  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2428  intb = 1
2429  inte = 1
2430  IF (lbound==3) THEN
2431  iedge = 10
2432  ELSE
2433  iedge = 11
2434  ENDIF
2435  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2436  DO ic = 1,grid%nCorns(ireg)
2437  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2438  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2439  ENDDO
2440  patch%position(3) = inte
2441  patch%position(4) = intb
2442 
2443  iset = 0
2444  DO ind=indbeg+1,indend-1
2445  ijkn = indijk(ind ,jbeg,kend,inoff,ijnoff)
2446  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2447  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2448  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2449  iset = 1
2450  EXIT
2451  ENDIF
2452  ENDDO
2453 
2454  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2455  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2456  .OR. &
2457 ! (intb==2 .OR. inte==2)) THEN
2458  (intb==2 .OR. inte==2) &
2459  .OR. &
2460  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2461  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2462  100._rfreal*eps)) .AND. (iset==0)) THEN
2463 
2464  dnbeg(:) = dnode(:,ijknbeg)
2465  dnend(:) = dnode(:,ijknend)
2466 
2467  arclen = 0._rfreal
2468  DO ind=indbeg+1,indend
2469  ijkn = indijk(ind ,jbeg,kend,inoff,ijnoff)
2470  ijkn1 = indijk(ind-1,jbeg,kend,inoff,ijnoff)
2471  arclen = arclen + &
2472  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2473  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2474  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2475  ENDDO
2476  ds = 0._rfreal
2477  DO ind=indbeg+1,indend-1
2478  ijkn = indijk(ind ,jbeg,kend,inoff,ijnoff)
2479  ijkn1 = indijk(ind-1,jbeg,kend,inoff,ijnoff)
2480  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2481  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2482  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2483  s = ds/arclen
2484  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2485  dnode(:,ijkn) = dn(:)
2486  ENDDO
2487  ENDIF
2488  ELSEIF (ipedge==4) THEN
2489  ib = ibeg
2490  ie = ibeg
2491  jb = jbeg
2492  je = jbeg
2493  kb = kbeg
2494  ke = kend
2495  indbeg = kb
2496  indend = ke
2497  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2498  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2499  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2500  intb = 1
2501  inte = 1
2502  IF (lbound==3) THEN
2503  iedge = 1
2504  ELSE
2505  iedge = 3
2506  ENDIF
2507  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2508  DO ic = 1,grid%nCorns(ireg)
2509  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2510  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2511  ENDDO
2512  patch%position(4) = inte
2513  patch%position(1) = intb
2514 
2515  iset = 0
2516  DO ind=indbeg+1,indend-1
2517  ijkn = indijk(ibeg,jbeg,ind ,inoff,ijnoff)
2518  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2519  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2520  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2521  iset = 1
2522  EXIT
2523  ENDIF
2524  ENDDO
2525 
2526  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2527  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2528  .OR. &
2529 ! (intb==2 .OR. inte==2)) THEN
2530  (intb==2 .OR. inte==2) &
2531  .OR. &
2532  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2533  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2534  100._rfreal*eps)) .AND. (iset==0)) THEN
2535 
2536  dnbeg(:) = dnode(:,ijknbeg)
2537  dnend(:) = dnode(:,ijknend)
2538 
2539  arclen = 0._rfreal
2540  DO ind=indbeg+1,indend
2541  ijkn = indijk(ibeg,jbeg,ind ,inoff,ijnoff)
2542  ijkn1 = indijk(ibeg,jbeg,ind-1,inoff,ijnoff)
2543  arclen = arclen + &
2544  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2545  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2546  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2547  ENDDO
2548  ds = 0._rfreal
2549  DO ind=indbeg+1,indend-1
2550  ijkn = indijk(ibeg,jbeg,ind ,inoff,ijnoff)
2551  ijkn1 = indijk(ibeg,jbeg,ind-1,inoff,ijnoff)
2552  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2553  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2554  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2555  s = ds/arclen
2556  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2557  dnode(:,ijkn) = dn(:)
2558  ENDDO
2559  ENDIF ! intb
2560  ENDIF ! ipEdge
2561  ENDIF ! lbound
2562 
2563  IF (lbound==5 .OR. lbound==6) THEN
2564  IF (ipedge==1) THEN
2565  ib = ibeg
2566  ie = ibeg
2567  jb = jbeg
2568  je = jend
2569  kb = kbeg
2570  ke = kbeg
2571  indbeg = jb
2572  indend = je
2573  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2574  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2575  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2576  intb = 1
2577  inte = 1
2578  IF (lbound==5) THEN
2579  iedge = 4
2580  ELSE
2581  iedge = 2
2582  ENDIF
2583  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2584  DO ic = 1,grid%nCorns(ireg)
2585  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2586  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2587  ENDDO
2588  patch%position(1) = intb
2589  patch%position(2) = inte
2590 
2591  iset = 0
2592  DO ind=indbeg+1,indend-1
2593  ijkn = indijk(ibeg,ind ,kbeg,inoff,ijnoff)
2594  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2595  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2596  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2597  iset = 1
2598  EXIT
2599  ENDIF
2600  ENDDO
2601 
2602  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2603  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2604  .OR. &
2605 ! (intb==2 .OR. inte==2)) THEN
2606  (intb==2 .OR. inte==2) &
2607  .OR. &
2608  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2609  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2610  100._rfreal*eps)) .AND. (iset==0)) THEN
2611 
2612  dnbeg(:) = dnode(:,ijknbeg)
2613  dnend(:) = dnode(:,ijknend)
2614 
2615  arclen = 0._rfreal
2616  DO ind=indbeg+1,indend
2617  ijkn = indijk(ibeg,ind ,kbeg,inoff,ijnoff)
2618  ijkn1 = indijk(ibeg,ind-1,kbeg,inoff,ijnoff)
2619  arclen = arclen + &
2620  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2621  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2622  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2623  ENDDO
2624  ds = 0._rfreal
2625  DO ind=indbeg+1,indend-1
2626  ijkn = indijk(ibeg,ind ,kbeg,inoff,ijnoff)
2627  ijkn1 = indijk(ibeg,ind-1,kbeg,inoff,ijnoff)
2628  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2629  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2630  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2631  s = ds/arclen
2632  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2633  dnode(:,ijkn) = dn(:)
2634  ENDDO
2635  ENDIF
2636  ELSEIF (ipedge==2) THEN
2637  ib = ibeg
2638  ie = iend
2639  jb = jend
2640  je = jend
2641  kb = kbeg
2642  ke = kbeg
2643  indbeg = ib
2644  indend = ie
2645  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2646  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2647  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2648  intb = 1
2649  inte = 1
2650  IF (lbound==5) THEN
2651  iedge = 12
2652  ELSE
2653  iedge = 11
2654  ENDIF
2655  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2656  DO ic = 1,grid%nCorns(ireg)
2657  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2658  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2659  ENDDO
2660  patch%position(2) = intb
2661  patch%position(3) = inte
2662 
2663  iset = 0
2664  DO ind=indbeg+1,indend-1
2665  ijkn = indijk(ind ,jend,kbeg,inoff,ijnoff)
2666  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2667  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2668  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2669  iset = 1
2670  EXIT
2671  ENDIF
2672  ENDDO
2673 
2674  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2675  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2676  .OR. &
2677 ! (intb==2 .OR. inte==2)) THEN
2678  (intb==2 .OR. inte==2) &
2679  .OR. &
2680  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2681  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2682  100._rfreal*eps)) .AND. (iset==0)) THEN
2683 
2684  dnbeg(:) = dnode(:,ijknbeg)
2685  dnend(:) = dnode(:,ijknend)
2686 
2687  arclen = 0._rfreal
2688  DO ind=indbeg+1,indend
2689  ijkn = indijk(ind ,jend,kbeg,inoff,ijnoff)
2690  ijkn1 = indijk(ind-1,jend,kbeg,inoff,ijnoff)
2691  arclen = arclen + &
2692  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2693  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2694  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2695  ENDDO
2696  ds = 0._rfreal
2697  DO ind=indbeg+1,indend-1
2698  ijkn = indijk(ind ,jend,kbeg,inoff,ijnoff)
2699  ijkn1 = indijk(ind-1,jend,kbeg,inoff,ijnoff)
2700  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2701  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2702  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2703  s = ds/arclen
2704  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2705  dnode(:,ijkn) = dn(:)
2706  ENDDO
2707  ENDIF
2708  ELSEIF (ipedge==3) THEN
2709  ib = iend
2710  ie = iend
2711  jb = jbeg
2712  je = jend
2713  kb = kbeg
2714  ke = kbeg
2715  indbeg = jb
2716  indend = je
2717  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2718  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2719  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2720  intb = 1
2721  inte = 1
2722  IF (lbound==5) THEN
2723  iedge = 8
2724  ELSE
2725  iedge = 6
2726  ENDIF
2727  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2728  DO ic = 1,grid%nCorns(ireg)
2729  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2730  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2731  ENDDO
2732  patch%position(3) = inte
2733  patch%position(4) = intb
2734 
2735  iset = 0
2736  DO ind=indbeg+1,indend-1
2737  ijkn = indijk(iend,ind ,kbeg,inoff,ijnoff)
2738  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2739  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2740  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2741  iset = 1
2742  EXIT
2743  ENDIF
2744  ENDDO
2745 
2746  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2747  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2748  .OR. &
2749 ! (intb==2 .OR. inte==2)) THEN
2750  (intb==2 .OR. inte==2) &
2751  .OR. &
2752  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2753  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2754  100._rfreal*eps)) .AND. (iset==0)) THEN
2755 
2756  dnbeg(:) = dnode(:,ijknbeg)
2757  dnend(:) = dnode(:,ijknend)
2758 
2759  arclen = 0._rfreal
2760  DO ind=indbeg+1,indend
2761  ijkn = indijk(iend,ind ,kbeg,inoff,ijnoff)
2762  ijkn1 = indijk(iend,ind-1,kbeg,inoff,ijnoff)
2763  arclen = arclen + &
2764  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2765  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2766  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2767  ENDDO
2768  ds = 0._rfreal
2769  DO ind=indbeg+1,indend-1
2770  ijkn = indijk(iend,ind ,kbeg,inoff,ijnoff)
2771  ijkn1 = indijk(iend,ind-1,kbeg,inoff,ijnoff)
2772  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2773  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2774  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2775  s = ds/arclen
2776  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2777  dnode(:,ijkn) = dn(:)
2778  ENDDO
2779  ENDIF
2780  ELSEIF (ipedge==4) THEN
2781  ib = ibeg
2782  ie = iend
2783  jb = jbeg
2784  je = jbeg
2785  kb = kbeg
2786  ke = kbeg
2787  indbeg = ib
2788  indend = ie
2789  ijknbeg = indijk(ib,jb,kb,inoff,ijnoff)
2790  ijknend = indijk(ie,je,ke,inoff,ijnoff)
2791  ijktest = indijk((ib+ie)/2,(jb+je)/2,(kb+ke)/2,inoff,ijnoff)
2792  intb = 1
2793  inte = 1
2794  IF (lbound==5) THEN
2795  iedge = 9
2796  ELSE
2797  iedge = 10
2798  ENDIF
2799  intertype = region%levels(ilev)%edgeCells(iedge)%interType
2800  DO ic = 1,grid%nCorns(ireg)
2801  IF (grid%ijkCorn(ic,ireg)==ijknbeg) intb = grid%nghbor(3,1,ic)
2802  IF (grid%ijkCorn(ic,ireg)==ijknend) inte = grid%nghbor(3,1,ic)
2803  ENDDO
2804  patch%position(4) = inte
2805  patch%position(1) = intb
2806 
2807  iset = 0
2808  DO ind=indbeg+1,indend-1
2809  ijkn = indijk(ind ,jbeg,kbeg,inoff,ijnoff)
2810  IF (abs( dnode(xcoord,ijkn) ) > 100._rfreal*eps .OR. &
2811  abs( dnode(ycoord,ijkn) ) > 100._rfreal*eps .OR. &
2812  abs( dnode(zcoord,ijkn) ) > 100._rfreal*eps) THEN
2813  iset = 1
2814  EXIT
2815  ENDIF
2816  ENDDO
2817 
2818  IF ((((intb/=0 .OR. inte/=0) .AND. (intertype==edge_interact_full .AND.&
2819  region%levels(ilev)%edgeCells(iedge)%interact .EQV. .true.)) &
2820  .OR. &
2821 ! (intb==2 .OR. inte==2)) THEN
2822  (intb==2 .OR. inte==2) &
2823  .OR. &
2824  ((intb==0 .AND. inte==0) .AND. abs(dnode(xcoord,ijktest)+ &
2825  dnode(ycoord,ijktest)+dnode(zcoord,ijktest)) < &
2826  100._rfreal*eps)) .AND. (iset==0)) THEN
2827 
2828  dnbeg(:) = dnode(:,ijknbeg)
2829  dnend(:) = dnode(:,ijknend)
2830 
2831  arclen = 0._rfreal
2832  DO ind=indbeg+1,indend
2833  ijkn = indijk(ind ,jbeg,kbeg,inoff,ijnoff)
2834  ijkn1 = indijk(ind-1,jbeg,kbeg,inoff,ijnoff)
2835  arclen = arclen + &
2836  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2837  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2838  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2839  ENDDO
2840  ds = 0._rfreal
2841  DO ind=indbeg+1,indend-1
2842  ijkn = indijk(ind ,jbeg,kbeg,inoff,ijnoff)
2843  ijkn1 = indijk(ind-1,jbeg,kbeg,inoff,ijnoff)
2844  ds = ds + sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkn1))**2 + &
2845  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkn1))**2 + &
2846  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkn1))**2)
2847  s = ds/arclen
2848  CALL rflo_tfint1d( s,dnbeg,dnend,dn )
2849  dnode(:,ijkn) = dn(:)
2850  ENDDO
2851  ENDIF ! intb
2852  ENDIF ! ipEdge
2853  ENDIF ! lbound
2854 
2855  ENDDO ! ipEdge
2856 
2857 777 CONTINUE
2858 
2859  ENDDO ! iPatch
2860 
2861 ! finalize --------------------------------------------------------------------
2862 
2863  CALL deregisterfunction( region%global )
2864 
2865 END SUBROUTINE rflo_mgframeedges
2866 
2867 !******************************************************************************
2868 !
2869 ! Purpose: exchange deformations between the regions as to ensure
2870 ! matching grid nodes at the interfaces.
2871 !
2872 ! Description: none.
2873 !
2874 ! Input: regions = data of all grid regions, deformations.
2875 !
2876 ! Output: regions%levels%grid%xyz = deformations at the boundaries.
2877 !
2878 ! Notes: grid%xyz temporarily stores nodal displacements. The deformation
2879 ! is applied to the finest grid first.
2880 !
2881 !******************************************************************************
2882 
2883 SUBROUTINE rflo_mgframeinterfaces( regions,iType )
2884 
2885  USE modinterfaces, ONLY : rflo_exchangednodecopy, rflo_edgedeformation, &
2886  rflo_boundarydeformation, rflo_exchangednodesend, &
2887  rflo_exchangednoderecv, rflo_clearsendrequests
2888  IMPLICIT NONE
2889 
2890 ! ... parameters
2891  TYPE(t_region), POINTER :: regions(:)
2892  INTEGER ::itype
2893 
2894 ! ... loop variables
2895  INTEGER :: ireg, ipatch, ipass
2896 
2897 ! ... local variables
2898  INTEGER :: bctype, iregsrc, ipatchsrc, ltype, npass
2899 
2900  TYPE(t_grid), POINTER :: grid, gridold, gridsrc
2901  TYPE(t_global), POINTER :: global
2902  TYPE(t_patch), POINTER :: patch, patchsrc
2903 
2904 !******************************************************************************
2905 
2906  global => regions(1)%global
2907 
2908  CALL registerfunction( global,'RFLO_MgFrameInterfaces',&
2909  'RFLO_ModMoveGridNconform2.F90' )
2910 
2911 ! fix interfaces between regions ----------------------------------------------
2912 
2913  ltype = 1
2914  npass = global%moveGridNsmatch
2915  DO ipass=1,npass
2916 
2917 ! - copy / send deformations
2918 
2919  DO ireg=1,global%nRegions
2920  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
2921  regions(ireg)%active==active .AND. & ! on my processor
2922  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
2923 
2924  grid => regions(ireg)%levels(1)%grid
2925  gridold => regions(ireg)%levels(1)%gridOld
2926 
2927  DO ipatch=1,regions(ireg)%nPatches
2928  patch => regions(ireg)%levels(1)%patches(ipatch)
2929  bctype = patch%bcType
2930  IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
2931  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
2932  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range)) THEN
2933  iregsrc = patch%srcRegion
2934  ipatchsrc = patch%srcPatch
2935  patchsrc => regions(iregsrc)%levels(1)%patches(ipatchsrc)
2936  gridsrc => regions(iregsrc)%levels(1)%grid
2937 
2938  IF (regions(iregsrc)%procid == global%myProcid) THEN
2939  CALL rflo_exchangednodecopy( regions(ireg),regions(iregsrc), &
2940  patch,patchsrc,.false., &
2941  grid%xyz,gridsrc%xyz )
2942  IF (ipass < npass .AND. ltype==1) THEN
2943  CALL rflo_mgframeedges( regions(ireg),grid%edgeMoved, &
2944  gridold%xyzOld,grid%xyz )
2945  CALL rflo_mgframerestoreexternal( regions(ireg) )
2946  CALL rflo_mgframebnddeformation( regions(ireg),gridold%xyzOld, &
2947  grid%xyz )
2948  ELSEIF (ipass < npass .AND. ltype==2) THEN
2949  CALL rflo_mgframeedgeso( regions(ireg),2,grid%boundMoved, &
2950  grid%allExternal,grid%edgeMoved, &
2951  grid%arcLen12,grid%arcLen34, &
2952  grid%arcLen56,gridold%xyzOld,grid%xyz )
2953  CALL rflo_boundarydeformation( regions(ireg), &
2954  grid%boundMoved, &
2955  grid%edgeMoved,grid%arcLen12, &
2956  grid%arcLen34,grid%arcLen56, &
2957  gridold%xyzOld,grid%xyz )
2958  ENDIF
2959  ELSE
2960  CALL rflo_exchangednodesend( regions(ireg),regions(iregsrc), &
2961  patch,grid%xyz )
2962  ENDIF
2963  ENDIF ! bcType
2964  ENDDO ! iPatch
2965 
2966  ENDIF ! region on this processor and active, grid moving
2967  ENDDO ! iReg
2968 
2969 ! - receive deformations
2970 
2971  DO ireg=1,global%nRegions
2972  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
2973  regions(ireg)%active==active .AND. & ! on my processor
2974  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
2975 
2976  grid => regions(ireg)%levels(1)%grid
2977  gridold => regions(ireg)%levels(1)%gridOld
2978 
2979  DO ipatch=1,regions(ireg)%nPatches
2980  patch => regions(ireg)%levels(1)%patches(ipatch)
2981  bctype = patch%bcType
2982  IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
2983  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
2984  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range)) THEN
2985  iregsrc = patch%srcRegion
2986  ipatchsrc = patch%srcPatch
2987  patchsrc => regions(iregsrc)%levels(1)%patches(ipatchsrc)
2988  gridsrc => regions(iregsrc)%levels(1)%grid
2989 
2990  IF (regions(iregsrc)%procid /= global%myProcid) THEN
2991  CALL rflo_exchangednoderecv( regions(ireg),regions(iregsrc), &
2992  patch,patchsrc,.false.,grid%xyz )
2993 
2994  IF (ipass < npass .AND. ltype==1) THEN
2995  CALL rflo_mgframeedges( regions(ireg),grid%edgeMoved, &
2996  gridold%xyzOld,grid%xyz )
2997  CALL rflo_mgframerestoreexternal( regions(ireg) )
2998  CALL rflo_mgframebnddeformation( regions(ireg),gridold%xyzOld, &
2999  grid%xyz )
3000  ELSEIF (ipass < npass .AND. ltype==2) THEN
3001  CALL rflo_mgframeedgeso( regions(ireg),2,grid%boundMoved, &
3002  grid%allExternal,grid%edgeMoved, &
3003  grid%arcLen12,grid%arcLen34, &
3004  grid%arcLen56,gridold%xyzOld,grid%xyz )
3005  CALL rflo_boundarydeformation( regions(ireg), &
3006  grid%boundMoved, &
3007  grid%edgeMoved,grid%arcLen12, &
3008  grid%arcLen34,grid%arcLen56, &
3009  gridold%xyzOld,grid%xyz )
3010  ENDIF
3011  ENDIF
3012  ENDIF ! bcType
3013  ENDDO ! iPatch
3014 
3015  ENDIF ! region on this processor and active, grid moving
3016  ENDDO ! iReg
3017 
3018 ! - clear send requests
3019 
3020  DO ireg=1,global%nRegions
3021  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
3022  regions(ireg)%active==active .AND. & ! on my processor
3023  regions(ireg)%mixtInput%moveGrid) THEN ! and moving
3024  CALL rflo_clearsendrequests( regions,ireg,.true. )
3025  ENDIF
3026  ENDDO
3027 
3028  ENDDO ! iPass
3029 
3030 ! finalize --------------------------------------------------------------------
3031 
3032  CALL deregisterfunction( global )
3033 
3034 END SUBROUTINE rflo_mgframeinterfaces
3035 
3036 !******************************************************************************
3037 !
3038 ! Purpose: calculate node displacements on those boundaries whose edges
3039 ! have moved but which were not marked as moving (finest grid only).
3040 !
3041 ! Description: none.
3042 !
3043 ! Input: region = grid dimensions
3044 ! boundMoved = flag for boundaries of a region which have moved
3045 ! edgeMoved = flag for edges whose nodes have moved
3046 ! arcLen12 = arclength between i=const. boundaries for each j, k
3047 ! arcLen34 = arclength between j=const. boundaries for each k, i
3048 ! arcLen56 = arclength between k=const. boundaries for each i, j
3049 ! xyzOld = grid from previous time step.
3050 !
3051 ! Output: dNode = updated deformations at boundaries.
3052 !
3053 ! Notes: variable dNode contains the whole 3-D field.
3054 !
3055 !******************************************************************************
3056 
3057 SUBROUTINE rflo_mgframebnddeformation0( region,boundMoved,edgeMoved, &
3058  arclen12,arclen34,arclen56, &
3059  xyzold,dnode )
3060 
3061  USE modinterfaces, ONLY : rflo_getnodeoffset, rflo_getdimensphysnodes, &
3062  rflo_tfint2d
3063  IMPLICIT NONE
3064 
3065 #include "Indexing.h"
3066 
3067 ! ... parameters
3068  LOGICAL :: boundmoved(6), edgemoved(12)
3069 
3070  REAL(RFREAL), POINTER :: arclen12(:,:), arclen34(:,:), arclen56(:,:)
3071  REAL(RFREAL), POINTER :: dnode(:,:), xyzold(:,:)
3072 
3073  TYPE(t_region) :: region
3074 
3075 ! ... loop variables
3076  INTEGER :: ibound, l1, l2
3077 
3078 ! ... local variables
3079  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
3080  INTEGER :: l1b, l1e, l2b, l2e, lc, ijkn, ijke(4), ijkem(4), inoff, ijnoff
3081  INTEGER :: switch(6,9)
3082 
3083  LOGICAL :: sum12
3084 
3085  REAL(RFREAL) :: arclen(4), ds(4), s(4)
3086  REAL(RFREAL) :: corner(3,8), e1(3), e2(3), e3(3), e4(3), &
3087  p1(3), p2(3), p3(3), p4(3), dn(3)
3088 
3089 !******************************************************************************
3090 
3091  CALL registerfunction( region%global,'RFLO_MgFrameBndDeformation0',&
3092  'RFLO_ModMoveGridNconform2.F90' )
3093 
3094 ! get dimensions --------------------------------------------------------------
3095 
3096  ilev = 1
3097  CALL rflo_getdimensphysnodes( region,ilev,ipnbeg,ipnend, &
3098  jpnbeg,jpnend,kpnbeg,kpnend )
3099  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
3100 
3101 ! set boundary switch ---------------------------------------------------------
3102 ! switch(:,1-4) = numbers of the 4 edges of a boundary
3103 ! switch(:,5-6) = first/last index in l1-direction
3104 ! switch(:,7-8) = first/last index in l2-direction
3105 ! switch(:, 9) = constant index
3106 
3107  switch(1,:) = (/ 1, 2, 3, 4, jpnbeg, jpnend, kpnbeg, kpnend, ipnbeg/)
3108  switch(2,:) = (/ 5, 6, 7, 8, jpnbeg, jpnend, kpnbeg, kpnend, ipnend/)
3109  switch(3,:) = (/ 1, 5, 9, 10, kpnbeg, kpnend, ipnbeg, ipnend, jpnbeg/)
3110  switch(4,:) = (/ 3, 7, 11, 12, kpnbeg, kpnend, ipnbeg, ipnend, jpnend/)
3111  switch(5,:) = (/ 4, 8, 9, 11, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg/)
3112  switch(6,:) = (/ 2, 6, 10, 12, ipnbeg, ipnend, jpnbeg, jpnend, kpnend/)
3113 
3114 ! store displacements at corners ----------------------------------------------
3115 
3116  corner(:,1) = dnode(:,indijk(ipnbeg,jpnbeg,kpnbeg,inoff,ijnoff))
3117  corner(:,2) = dnode(:,indijk(ipnbeg,jpnbeg,kpnend,inoff,ijnoff))
3118  corner(:,3) = dnode(:,indijk(ipnbeg,jpnend,kpnend,inoff,ijnoff))
3119  corner(:,4) = dnode(:,indijk(ipnbeg,jpnend,kpnbeg,inoff,ijnoff))
3120  corner(:,5) = dnode(:,indijk(ipnend,jpnbeg,kpnbeg,inoff,ijnoff))
3121  corner(:,6) = dnode(:,indijk(ipnend,jpnbeg,kpnend,inoff,ijnoff))
3122  corner(:,7) = dnode(:,indijk(ipnend,jpnend,kpnend,inoff,ijnoff))
3123  corner(:,8) = dnode(:,indijk(ipnend,jpnend,kpnbeg,inoff,ijnoff))
3124 
3125 ! move nodes on boundaries with active edges ----------------------------------
3126 
3127  DO ibound=1,6
3128 ! IF ((.NOT.boundMoved(iBound)) .AND. &
3129 ! (edgeMoved(switch(iBound,1)) .OR. edgeMoved(switch(iBound,2)) .OR. &
3130 ! edgeMoved(switch(iBound,3)) .OR. edgeMoved(switch(iBound,4)))) THEN
3131 
3132  IF ((edgemoved(switch(ibound,1)) .OR. edgemoved(switch(ibound,2)) .OR. &
3133  edgemoved(switch(ibound,3)) .OR. edgemoved(switch(ibound,4)))) THEN
3134 
3135  l1b = switch(ibound,5)
3136  l1e = switch(ibound,6)
3137  l2b = switch(ibound,7)
3138  l2e = switch(ibound,8)
3139  lc = switch(ibound,9)
3140 
3141  IF (ibound == 1) THEN
3142  p1(:) = corner(:,1)
3143  p2(:) = corner(:,4)
3144  p3(:) = corner(:,3)
3145  p4(:) = corner(:,2)
3146  ELSE IF (ibound == 2) THEN
3147  p1(:) = corner(:,5)
3148  p2(:) = corner(:,8)
3149  p3(:) = corner(:,7)
3150  p4(:) = corner(:,6)
3151  ELSE IF (ibound == 3) THEN
3152  p1(:) = corner(:,1)
3153  p2(:) = corner(:,2)
3154  p3(:) = corner(:,6)
3155  p4(:) = corner(:,5)
3156  ELSE IF (ibound == 4) THEN
3157  p1(:) = corner(:,4)
3158  p2(:) = corner(:,3)
3159  p3(:) = corner(:,7)
3160  p4(:) = corner(:,8)
3161  ELSE IF (ibound == 5) THEN
3162  p1(:) = corner(:,1)
3163  p2(:) = corner(:,5)
3164  p3(:) = corner(:,8)
3165  p4(:) = corner(:,4)
3166  ELSE IF (ibound == 6) THEN
3167  p1(:) = corner(:,2)
3168  p2(:) = corner(:,6)
3169  p3(:) = corner(:,7)
3170  p4(:) = corner(:,3)
3171  ENDIF
3172 
3173  ds(1:2) = 0._rfreal
3174  DO l2=l2b+1,l2e-1
3175 
3176  sum12 = .true.
3177  ds(3:4) = 0._rfreal
3178  DO l1=l1b+1,l1e-1
3179  IF (ibound==1 .OR. ibound==2) THEN
3180  ijkn = indijk(lc,l1 ,l2 ,inoff,ijnoff)
3181  ijke(1) = indijk(lc,jpnbeg,l2 ,inoff,ijnoff)
3182  ijkem(1) = indijk(lc,jpnbeg,l2-1 ,inoff,ijnoff)
3183  ijke(2) = indijk(lc,jpnend,l2 ,inoff,ijnoff)
3184  ijkem(2) = indijk(lc,jpnend,l2-1 ,inoff,ijnoff)
3185  ijke(3) = indijk(lc,l1 ,kpnbeg,inoff,ijnoff)
3186  ijkem(3) = indijk(lc,l1-1 ,kpnbeg,inoff,ijnoff)
3187  ijke(4) = indijk(lc,l1 ,kpnend,inoff,ijnoff)
3188  ijkem(4) = indijk(lc,l1-1 ,kpnend,inoff,ijnoff)
3189  arclen(1) = arclen56(lc,jpnbeg)
3190  arclen(2) = arclen56(lc,jpnend)
3191  arclen(3) = arclen34(kpnbeg,lc)
3192  arclen(4) = arclen34(kpnend,lc)
3193  ELSE IF (ibound==3 .OR. ibound==4) THEN
3194  ijkn = indijk(l2 ,lc,l1 ,inoff,ijnoff)
3195  ijke(1) = indijk(l2 ,lc,kpnbeg,inoff,ijnoff)
3196  ijkem(1) = indijk(l2-1 ,lc,kpnbeg,inoff,ijnoff)
3197  ijke(2) = indijk(l2 ,lc,kpnend,inoff,ijnoff)
3198  ijkem(2) = indijk(l2-1 ,lc,kpnend,inoff,ijnoff)
3199  ijke(3) = indijk(ipnbeg,lc,l1 ,inoff,ijnoff)
3200  ijkem(3) = indijk(ipnbeg,lc,l1-1 ,inoff,ijnoff)
3201  ijke(4) = indijk(ipnend,lc,l1 ,inoff,ijnoff)
3202  ijkem(4) = indijk(ipnend,lc,l1-1 ,inoff,ijnoff)
3203  arclen(1) = arclen12(lc,kpnbeg)
3204  arclen(2) = arclen12(lc,kpnend)
3205  arclen(3) = arclen56(ipnbeg,lc)
3206  arclen(4) = arclen56(ipnend,lc)
3207  ELSE IF (ibound==5 .OR. ibound==6) THEN
3208  ijkn = indijk(l1 ,l2 ,lc,inoff,ijnoff)
3209  ijke(1) = indijk(ipnbeg,l2 ,lc,inoff,ijnoff)
3210  ijkem(1) = indijk(ipnbeg,l2-1 ,lc,inoff,ijnoff)
3211  ijke(2) = indijk(ipnend,l2 ,lc,inoff,ijnoff)
3212  ijkem(2) = indijk(ipnend,l2-1 ,lc,inoff,ijnoff)
3213  ijke(3) = indijk(l1 ,jpnbeg,lc,inoff,ijnoff)
3214  ijkem(3) = indijk(l1-1 ,jpnbeg,lc,inoff,ijnoff)
3215  ijke(4) = indijk(l1 ,jpnend,lc,inoff,ijnoff)
3216  ijkem(4) = indijk(l1-1 ,jpnend,lc,inoff,ijnoff)
3217  arclen(1) = arclen34(lc,ipnbeg)
3218  arclen(2) = arclen34(lc,ipnend)
3219  arclen(3) = arclen12(jpnbeg,lc)
3220  arclen(4) = arclen12(jpnend,lc)
3221  ENDIF
3222  IF (sum12) THEN
3223  ds(1) = ds(1) + &
3224  sqrt((xyzold(xcoord,ijke(1))-xyzold(xcoord,ijkem(1)))**2 + &
3225  (xyzold(ycoord,ijke(1))-xyzold(ycoord,ijkem(1)))**2 + &
3226  (xyzold(zcoord,ijke(1))-xyzold(zcoord,ijkem(1)))**2)
3227  ds(2) = ds(2) + &
3228  sqrt((xyzold(xcoord,ijke(2))-xyzold(xcoord,ijkem(2)))**2 + &
3229  (xyzold(ycoord,ijke(2))-xyzold(ycoord,ijkem(2)))**2 + &
3230  (xyzold(zcoord,ijke(2))-xyzold(zcoord,ijkem(2)))**2)
3231  sum12 = .false.
3232  ENDIF
3233  ds(3) = ds(3) + &
3234  sqrt((xyzold(xcoord,ijke(3))-xyzold(xcoord,ijkem(3)))**2 + &
3235  (xyzold(ycoord,ijke(3))-xyzold(ycoord,ijkem(3)))**2 + &
3236  (xyzold(zcoord,ijke(3))-xyzold(zcoord,ijkem(3)))**2)
3237  ds(4) = ds(4) + &
3238  sqrt((xyzold(xcoord,ijke(4))-xyzold(xcoord,ijkem(4)))**2 + &
3239  (xyzold(ycoord,ijke(4))-xyzold(ycoord,ijkem(4)))**2 + &
3240  (xyzold(zcoord,ijke(4))-xyzold(zcoord,ijkem(4)))**2)
3241  s(:) = ds(:)/arclen(:)
3242  e1(:) = dnode(:,ijke(1))
3243  e2(:) = dnode(:,ijke(2))
3244  e3(:) = dnode(:,ijke(3))
3245  e4(:) = dnode(:,ijke(4))
3246  CALL rflo_tfint2d( s(1),s(2),s(3),s(4),e1,e2,e3,e4,p1,p2,p3,p4,dn )
3247  dnode(:,ijkn) = dn(:)
3248  ENDDO ! l1
3249  ENDDO ! l2
3250 
3251  ENDIF ! edgeMoved
3252  ENDDO ! iBound
3253 
3254 ! finalize --------------------------------------------------------------------
3255 
3256  CALL deregisterfunction( region%global )
3257 
3258 END SUBROUTINE rflo_mgframebnddeformation0
3259 
3260 !******************************************************************************
3261 !
3262 ! Purpose: calculate node displacements on non-external patches
3263 ! (finest grid only).
3264 !
3265 ! Description: none.
3266 !
3267 ! Input: region = grid dimensions
3268 ! xyzOld = grid from previous time step.
3269 !
3270 ! Output: dNode = updated deformations at boundaries.
3271 !
3272 ! Notes: variable dNode contains the whole 3-D field.
3273 !
3274 !******************************************************************************
3275 
3276 SUBROUTINE rflo_mgframebnddeformation( region,xyzOld,dNode )
3277 
3278  USE modinterfaces, ONLY : rflo_getnodeoffset, rflo_getpatchindicesnodes, &
3279  rflo_tfint2d
3280  IMPLICIT NONE
3281 
3282 #include "Indexing.h"
3283 
3284 ! ... parameters
3285 
3286  REAL(RFREAL), POINTER :: dnode(:,:), xyzold(:,:)
3287 
3288  TYPE(t_region) :: region
3289 
3290 ! ... loop variables
3291  INTEGER :: ipatch, l1, l2
3292 
3293 ! ... local variables
3294  INTEGER :: ilev, ibound, ibeg, iend, jbeg, jend, kbeg, kend
3295  INTEGER :: l1b, l1e, l2b, l2e, lc, ijkn, ijke(4), ijkem(4), inoff, ijnoff
3296  INTEGER :: switch(6,9)
3297 
3298  LOGICAL :: sum12
3299  REAL(RFREAL) :: arclen(4), ds(4), s(4)
3300  REAL(RFREAL) :: e1(3), e2(3), e3(3), e4(3), &
3301  p1(3), p2(3), p3(3), p4(3), dn(3)
3302  TYPE(t_patch), POINTER :: patch
3303 
3304 !******************************************************************************
3305 
3306  CALL registerfunction( region%global,'RFLO_MgFrameBndDeformation',&
3307  'RFLO_ModMoveGridNconform2.F90' )
3308 
3309 ! get dimensions --------------------------------------------------------------
3310 
3311  ilev = 1
3312  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
3313 
3314 ! set boundary switch ---------------------------------------------------------
3315 ! switch(:,1-4) = numbers of the 4 edges of a boundary
3316 ! switch(:,5-6) = first/last index in l1-direction
3317 ! switch(:,7-8) = first/last index in l2-direction
3318 ! switch(:, 9) = constant index
3319 
3320 ! move nodes on boundaries with active edges ----------------------------------
3321 
3322  DO ipatch=1,region%nPatches
3323  patch => region%levels(ilev)%patches(ipatch)
3324  ibound = patch%lbound
3325 
3326  CALL rflo_getpatchindicesnodes( region,patch,ilev, &
3327  ibeg,iend,jbeg,jend,kbeg,kend )
3328 
3329  IF (patch%bcMotion/=bc_external) THEN
3330 
3331  switch(1,:) = (/ 1, 2, 3, 4, jbeg, jend, kbeg, kend, ibeg/)
3332  switch(2,:) = (/ 5, 6, 7, 8, jbeg, jend, kbeg, kend, iend/)
3333  switch(3,:) = (/ 1, 5, 9, 10, kbeg, kend, ibeg, iend, jbeg/)
3334  switch(4,:) = (/ 3, 7, 11, 12, kbeg, kend, ibeg, iend, jend/)
3335  switch(5,:) = (/ 4, 8, 9, 11, ibeg, iend, jbeg, jend, kbeg/)
3336  switch(6,:) = (/ 2, 6, 10, 12, ibeg, iend, jbeg, jend, kend/)
3337 
3338  l1b = switch(ibound,5)
3339  l1e = switch(ibound,6)
3340  l2b = switch(ibound,7)
3341  l2e = switch(ibound,8)
3342  lc = switch(ibound,9)
3343 
3344  p1(:) = dnode(:,patch%corns(1))
3345  p2(:) = dnode(:,patch%corns(4))
3346  p3(:) = dnode(:,patch%corns(3))
3347  p4(:) = dnode(:,patch%corns(2))
3348 
3349 ! --- compute arclen along patch edges
3350 
3351  IF (ibound==1 .OR. ibound==2) THEN
3352  arclen(1:2) = 0._rfreal
3353  DO l2=l2b+1,l2e
3354  ijkn = indijk(lc,l1 ,l2 ,inoff,ijnoff)
3355  ijke(1) = indijk(lc,jbeg ,l2 ,inoff,ijnoff)
3356  ijkem(1) = indijk(lc,jbeg ,l2-1 ,inoff,ijnoff)
3357  ijke(2) = indijk(lc,jend ,l2 ,inoff,ijnoff)
3358  ijkem(2) = indijk(lc,jend ,l2-1 ,inoff,ijnoff)
3359  arclen(1) = arclen(1) + &
3360  sqrt((xyzold(xcoord,ijke(1))-xyzold(xcoord,ijkem(1)))**2 + &
3361  (xyzold(ycoord,ijke(1))-xyzold(ycoord,ijkem(1)))**2 + &
3362  (xyzold(zcoord,ijke(1))-xyzold(zcoord,ijkem(1)))**2)
3363  arclen(2) = arclen(2) + &
3364  sqrt((xyzold(xcoord,ijke(2))-xyzold(xcoord,ijkem(2)))**2 + &
3365  (xyzold(ycoord,ijke(2))-xyzold(ycoord,ijkem(2)))**2 + &
3366  (xyzold(zcoord,ijke(2))-xyzold(zcoord,ijkem(2)))**2)
3367  ENDDO
3368  arclen(3:4) = 0._rfreal
3369  DO l1=l1b+1,l1e
3370  ijkn = indijk(lc,l1 ,l2 ,inoff,ijnoff)
3371  ijke(3) = indijk(lc,l1 ,kbeg ,inoff,ijnoff)
3372  ijkem(3) = indijk(lc,l1-1 ,kbeg ,inoff,ijnoff)
3373  ijke(4) = indijk(lc,l1 ,kend ,inoff,ijnoff)
3374  ijkem(4) = indijk(lc,l1-1 ,kend ,inoff,ijnoff)
3375  arclen(3) = arclen(3) + &
3376  sqrt((xyzold(xcoord,ijke(3))-xyzold(xcoord,ijkem(3)))**2 + &
3377  (xyzold(ycoord,ijke(3))-xyzold(ycoord,ijkem(3)))**2 + &
3378  (xyzold(zcoord,ijke(3))-xyzold(zcoord,ijkem(3)))**2)
3379  arclen(4) = arclen(4) + &
3380  sqrt((xyzold(xcoord,ijke(4))-xyzold(xcoord,ijkem(4)))**2 + &
3381  (xyzold(ycoord,ijke(4))-xyzold(ycoord,ijkem(4)))**2 + &
3382  (xyzold(zcoord,ijke(4))-xyzold(zcoord,ijkem(4)))**2)
3383  ENDDO
3384  ELSE IF (ibound==3 .OR. ibound==4) THEN
3385  arclen(1:2) = 0._rfreal
3386  DO l2=l2b+1,l2e
3387  ijkn = indijk(l2 ,lc,l1 ,inoff,ijnoff)
3388  ijke(1) = indijk(l2 ,lc,kbeg ,inoff,ijnoff)
3389  ijkem(1) = indijk(l2-1 ,lc,kbeg ,inoff,ijnoff)
3390  ijke(2) = indijk(l2 ,lc,kend ,inoff,ijnoff)
3391  ijkem(2) = indijk(l2-1 ,lc,kend ,inoff,ijnoff)
3392  arclen(1) = arclen(1) + &
3393  sqrt((xyzold(xcoord,ijke(1))-xyzold(xcoord,ijkem(1)))**2 + &
3394  (xyzold(ycoord,ijke(1))-xyzold(ycoord,ijkem(1)))**2 + &
3395  (xyzold(zcoord,ijke(1))-xyzold(zcoord,ijkem(1)))**2)
3396  arclen(2) = arclen(2) + &
3397  sqrt((xyzold(xcoord,ijke(2))-xyzold(xcoord,ijkem(2)))**2 + &
3398  (xyzold(ycoord,ijke(2))-xyzold(ycoord,ijkem(2)))**2 + &
3399  (xyzold(zcoord,ijke(2))-xyzold(zcoord,ijkem(2)))**2)
3400  ENDDO
3401  arclen(3:4) = 0._rfreal
3402  DO l1=l1b+1,l1e
3403  ijkn = indijk(l2 ,lc,l1 ,inoff,ijnoff)
3404  ijke(3) = indijk(ibeg ,lc,l1 ,inoff,ijnoff)
3405  ijkem(3) = indijk(ibeg ,lc,l1-1 ,inoff,ijnoff)
3406  ijke(4) = indijk(iend ,lc,l1 ,inoff,ijnoff)
3407  ijkem(4) = indijk(iend ,lc,l1-1 ,inoff,ijnoff)
3408  arclen(3) = arclen(3) + &
3409  sqrt((xyzold(xcoord,ijke(3))-xyzold(xcoord,ijkem(3)))**2 + &
3410  (xyzold(ycoord,ijke(3))-xyzold(ycoord,ijkem(3)))**2 + &
3411  (xyzold(zcoord,ijke(3))-xyzold(zcoord,ijkem(3)))**2)
3412  arclen(4) = arclen(4) + &
3413  sqrt((xyzold(xcoord,ijke(4))-xyzold(xcoord,ijkem(4)))**2 + &
3414  (xyzold(ycoord,ijke(4))-xyzold(ycoord,ijkem(4)))**2 + &
3415  (xyzold(zcoord,ijke(4))-xyzold(zcoord,ijkem(4)))**2)
3416  ENDDO
3417  ELSE IF (ibound==5 .OR. ibound==6) THEN
3418  arclen(1:2) = 0._rfreal
3419  DO l2=l2b+1,l2e
3420  ijkn = indijk(l1 ,l2 ,lc,inoff,ijnoff)
3421  ijke(1) = indijk(ibeg ,l2 ,lc,inoff,ijnoff)
3422  ijkem(1) = indijk(ibeg ,l2-1 ,lc,inoff,ijnoff)
3423  ijke(2) = indijk(iend ,l2 ,lc,inoff,ijnoff)
3424  ijkem(2) = indijk(iend ,l2-1 ,lc,inoff,ijnoff)
3425  arclen(1) = arclen(1) + &
3426  sqrt((xyzold(xcoord,ijke(1))-xyzold(xcoord,ijkem(1)))**2 + &
3427  (xyzold(ycoord,ijke(1))-xyzold(ycoord,ijkem(1)))**2 + &
3428  (xyzold(zcoord,ijke(1))-xyzold(zcoord,ijkem(1)))**2)
3429  arclen(2) = arclen(2) + &
3430  sqrt((xyzold(xcoord,ijke(2))-xyzold(xcoord,ijkem(2)))**2 + &
3431  (xyzold(ycoord,ijke(2))-xyzold(ycoord,ijkem(2)))**2 + &
3432  (xyzold(zcoord,ijke(2))-xyzold(zcoord,ijkem(2)))**2)
3433  ENDDO
3434  arclen(3:4) = 0._rfreal
3435  DO l1=l1b+1,l1e
3436  ijkn = indijk(l1 ,l2 ,lc,inoff,ijnoff)
3437  ijke(3) = indijk(l1 ,jbeg ,lc,inoff,ijnoff)
3438  ijkem(3) = indijk(l1-1 ,jbeg ,lc,inoff,ijnoff)
3439  ijke(4) = indijk(l1 ,jend ,lc,inoff,ijnoff)
3440  ijkem(4) = indijk(l1-1 ,jend ,lc,inoff,ijnoff)
3441  arclen(3) = arclen(3) + &
3442  sqrt((xyzold(xcoord,ijke(3))-xyzold(xcoord,ijkem(3)))**2 + &
3443  (xyzold(ycoord,ijke(3))-xyzold(ycoord,ijkem(3)))**2 + &
3444  (xyzold(zcoord,ijke(3))-xyzold(zcoord,ijkem(3)))**2)
3445  arclen(4) = arclen(4) + &
3446  sqrt((xyzold(xcoord,ijke(4))-xyzold(xcoord,ijkem(4)))**2 + &
3447  (xyzold(ycoord,ijke(4))-xyzold(ycoord,ijkem(4)))**2 + &
3448  (xyzold(zcoord,ijke(4))-xyzold(zcoord,ijkem(4)))**2)
3449  ENDDO
3450  ENDIF
3451 
3452 ! --- conduct TFI on interior patch surface
3453 
3454  ds(1:2) = 0._rfreal
3455  DO l2=l2b+1,l2e-1
3456 
3457  sum12 = .true.
3458  ds(3:4) = 0._rfreal
3459  DO l1=l1b+1,l1e-1
3460  IF (ibound==1 .OR. ibound==2) THEN
3461  ijkn = indijk(lc,l1 ,l2 ,inoff,ijnoff)
3462  ijke(1) = indijk(lc,jbeg ,l2 ,inoff,ijnoff)
3463  ijkem(1) = indijk(lc,jbeg ,l2-1 ,inoff,ijnoff)
3464  ijke(2) = indijk(lc,jend ,l2 ,inoff,ijnoff)
3465  ijkem(2) = indijk(lc,jend ,l2-1 ,inoff,ijnoff)
3466  ijke(3) = indijk(lc,l1 ,kbeg ,inoff,ijnoff)
3467  ijkem(3) = indijk(lc,l1-1 ,kbeg ,inoff,ijnoff)
3468  ijke(4) = indijk(lc,l1 ,kend ,inoff,ijnoff)
3469  ijkem(4) = indijk(lc,l1-1 ,kend ,inoff,ijnoff)
3470  ELSE IF (ibound==3 .OR. ibound==4) THEN
3471  ijkn = indijk(l2 ,lc,l1 ,inoff,ijnoff)
3472  ijke(1) = indijk(l2 ,lc,kbeg ,inoff,ijnoff)
3473  ijkem(1) = indijk(l2-1 ,lc,kbeg ,inoff,ijnoff)
3474  ijke(2) = indijk(l2 ,lc,kend ,inoff,ijnoff)
3475  ijkem(2) = indijk(l2-1 ,lc,kend ,inoff,ijnoff)
3476  ijke(3) = indijk(ibeg ,lc,l1 ,inoff,ijnoff)
3477  ijkem(3) = indijk(ibeg ,lc,l1-1 ,inoff,ijnoff)
3478  ijke(4) = indijk(iend ,lc,l1 ,inoff,ijnoff)
3479  ijkem(4) = indijk(iend ,lc,l1-1 ,inoff,ijnoff)
3480  ELSE IF (ibound==5 .OR. ibound==6) THEN
3481  ijkn = indijk(l1 ,l2 ,lc,inoff,ijnoff)
3482  ijke(1) = indijk(ibeg ,l2 ,lc,inoff,ijnoff)
3483  ijkem(1) = indijk(ibeg ,l2-1 ,lc,inoff,ijnoff)
3484  ijke(2) = indijk(iend ,l2 ,lc,inoff,ijnoff)
3485  ijkem(2) = indijk(iend ,l2-1 ,lc,inoff,ijnoff)
3486  ijke(3) = indijk(l1 ,jbeg ,lc,inoff,ijnoff)
3487  ijkem(3) = indijk(l1-1 ,jbeg ,lc,inoff,ijnoff)
3488  ijke(4) = indijk(l1 ,jend ,lc,inoff,ijnoff)
3489  ijkem(4) = indijk(l1-1 ,jend ,lc,inoff,ijnoff)
3490  ENDIF
3491  IF (sum12) THEN
3492  ds(1) = ds(1) + &
3493  sqrt((xyzold(xcoord,ijke(1))-xyzold(xcoord,ijkem(1)))**2 + &
3494  (xyzold(ycoord,ijke(1))-xyzold(ycoord,ijkem(1)))**2 + &
3495  (xyzold(zcoord,ijke(1))-xyzold(zcoord,ijkem(1)))**2)
3496  ds(2) = ds(2) + &
3497  sqrt((xyzold(xcoord,ijke(2))-xyzold(xcoord,ijkem(2)))**2 + &
3498  (xyzold(ycoord,ijke(2))-xyzold(ycoord,ijkem(2)))**2 + &
3499  (xyzold(zcoord,ijke(2))-xyzold(zcoord,ijkem(2)))**2)
3500  sum12 = .false.
3501  ENDIF
3502  ds(3) = ds(3) + &
3503  sqrt((xyzold(xcoord,ijke(3))-xyzold(xcoord,ijkem(3)))**2 + &
3504  (xyzold(ycoord,ijke(3))-xyzold(ycoord,ijkem(3)))**2 + &
3505  (xyzold(zcoord,ijke(3))-xyzold(zcoord,ijkem(3)))**2)
3506  ds(4) = ds(4) + &
3507  sqrt((xyzold(xcoord,ijke(4))-xyzold(xcoord,ijkem(4)))**2 + &
3508  (xyzold(ycoord,ijke(4))-xyzold(ycoord,ijkem(4)))**2 + &
3509  (xyzold(zcoord,ijke(4))-xyzold(zcoord,ijkem(4)))**2)
3510  s(:) = ds(:)/arclen(:)
3511  e1(:) = dnode(:,ijke(1))
3512  e2(:) = dnode(:,ijke(2))
3513  e3(:) = dnode(:,ijke(3))
3514  e4(:) = dnode(:,ijke(4))
3515  CALL rflo_tfint2d( s(1),s(2),s(3),s(4),e1,e2,e3,e4,p1,p2,p3,p4,dn )
3516  dnode(:,ijkn) = dn(:)
3517  ENDDO ! l1
3518  ENDDO ! l2
3519 
3520  ENDIF ! not.external
3521  ENDDO ! iPatch
3522 
3523 ! finalize --------------------------------------------------------------------
3524 
3525  CALL deregisterfunction( region%global )
3526 
3527 END SUBROUTINE rflo_mgframebnddeformation
3528 
3529 ! ******************************************************************************
3530 ! End
3531 ! ******************************************************************************
3532 
3533 END MODULE rflo_modmovegridframe
3534 
3535 ! ******************************************************************************
3536 !
3537 ! RCS Revision history:
3538 !
3539 ! $Log: RFLO_ModMoveGridNconform2.F90,v $
3540 ! Revision 1.35 2009/08/27 14:04:51 mtcampbe
3541 ! Updated to enable burning motion with symmetry boundaries and enhanced
3542 ! burnout code.
3543 !
3544 ! Revision 1.34 2008/12/06 08:44:17 mtcampbe
3545 ! Updated license.
3546 !
3547 ! Revision 1.33 2008/11/19 22:17:28 mtcampbe
3548 ! Added Illinois Open Source License/Copyright
3549 !
3550 ! Revision 1.32 2006/03/18 11:03:00 wasistho
3551 ! screen printed global skewness and minvol
3552 !
3553 ! Revision 1.31 2006/03/05 22:27:54 wasistho
3554 ! fixed syntax error
3555 !
3556 ! Revision 1.30 2006/03/05 21:52:14 wasistho
3557 ! changed computational space coordinates to be based on initial grid
3558 !
3559 ! Revision 1.29 2006/02/11 03:53:24 wasistho
3560 ! made some routines public
3561 !
3562 ! Revision 1.28 2006/01/28 22:52:45 wasistho
3563 ! fixed iEdgeGlo
3564 !
3565 ! Revision 1.27 2005/11/16 22:52:14 wasistho
3566 ! update screen print moveGridFOMS
3567 !
3568 ! Revision 1.26 2005/11/01 01:18:19 wasistho
3569 ! increased tolerance in frameEdges
3570 !
3571 ! Revision 1.25 2005/10/28 07:40:48 wasistho
3572 ! modified FORMAT 1000
3573 !
3574 ! Revision 1.24 2005/10/28 02:53:15 wasistho
3575 ! modified mgFrameEdges
3576 !
3577 ! Revision 1.23 2005/10/27 19:19:56 wasistho
3578 ! modified screen print
3579 !
3580 ! Revision 1.22 2005/10/27 05:57:05 wasistho
3581 ! added MoveGridFoms
3582 !
3583 ! Revision 1.21 2005/08/18 19:51:27 wasistho
3584 ! added user define nPass in mgFrameInterface
3585 !
3586 ! Revision 1.20 2005/07/10 21:13:13 wasistho
3587 ! global alloc dist in SrchNeighbors and CorrectNeighbors, and added pointer grid in mgFrameMoveCorners
3588 !
3589 ! Revision 1.19 2005/07/04 22:07:37 wasistho
3590 ! ABS operator was missing in the previous modification
3591 !
3592 ! Revision 1.18 2005/07/04 12:07:05 wasistho
3593 ! another mgFrameEdge modification to better accomodate non-conforming blocking
3594 !
3595 ! Revision 1.17 2005/07/02 23:10:53 wasistho
3596 ! modified mgFrameEdges, Surfaces and Interfaces to move edges between slots
3597 !
3598 ! Revision 1.16 2005/06/30 19:10:07 wasistho
3599 ! made official last added conditions in mgFrameEdges
3600 !
3601 ! Revision 1.15 2005/06/30 07:57:00 wasistho
3602 ! additional condition to move patchEdges in mgFrameEdges
3603 !
3604 ! Revision 1.14 2005/06/29 22:53:31 wasistho
3605 ! added interType condition in mgFrameEdges
3606 !
3607 ! Revision 1.13 2005/06/29 08:44:03 wasistho
3608 ! changed RestoreExternal and set lTyp=1
3609 !
3610 ! Revision 1.12 2005/06/29 04:55:48 wasistho
3611 ! modified RFLO_MgFrameInterfaces
3612 !
3613 ! Revision 1.11 2005/06/27 19:22:50 wasistho
3614 ! only ipass=1 in mgFrameInterfaces
3615 !
3616 ! Revision 1.10 2005/06/27 01:00:45 wasistho
3617 ! stored tolerance in tol
3618 !
3619 ! Revision 1.9 2005/06/27 00:36:42 wasistho
3620 ! change tolerance in mgFrameSrchNeighbors from 1.e-20 to 1.e-5*edgeLen
3621 !
3622 ! Revision 1.8 2005/06/26 06:25:32 wasistho
3623 ! nReg==72 to nReg==71
3624 !
3625 ! Revision 1.7 2005/06/26 06:11:48 wasistho
3626 ! adding more reegions for titan check in mgFrameSrchCorners
3627 !
3628 ! Revision 1.6 2005/06/26 05:39:29 wasistho
3629 ! bugs fixed in mgFrameCornPoints and mgFrameSrchNeighbors
3630 !
3631 ! Revision 1.5 2005/06/25 08:12:19 wasistho
3632 ! bug fixed in receiving rvar in mgFrameBCast
3633 !
3634 ! Revision 1.4 2005/06/25 06:16:05 wasistho
3635 ! swap ENDDO and ENDIF in mgframeBroadCast
3636 !
3637 ! Revision 1.3 2005/06/25 03:14:06 wasistho
3638 ! enabled nRegions /= nProcs in type 2 gridmotion
3639 !
3640 ! Revision 1.2 2005/06/23 08:54:46 wasistho
3641 ! fixed bug rdenom should be sum over nbour
3642 !
3643 ! Revision 1.1 2005/06/23 01:37:33 wasistho
3644 ! make number of closest neighbors user input
3645 !
3646 ! Revision 1.12 2005/06/19 12:36:00 wasistho
3647 ! update in mgFrameInterfaces
3648 !
3649 ! Revision 1.11 2005/06/17 03:51:22 wasistho
3650 ! argument in RFLO_exchangeDnodeCopy/Recv is set from true to false
3651 !
3652 ! Revision 1.10 2005/06/16 01:28:02 wasistho
3653 ! modified mgFrameBndDeformation to allow TFI per patch i.o per block-side
3654 !
3655 ! Revision 1.9 2005/06/15 19:20:47 wasistho
3656 ! simplified mgFrameInterfaces and copied RFLO_ModMoveGridNconform to RFLO_ModMoveGridFrame
3657 !
3658 ! Revision 1.8 2005/06/14 11:20:35 wasistho
3659 ! set itype to 1
3660 !
3661 ! Revision 1.7 2005/06/13 21:47:35 wasistho
3662 ! changed patch%bcCoupled to patch%bcMotion
3663 !
3664 ! Revision 1.6 2005/06/13 01:18:57 wasistho
3665 ! bug fixed in MgFrameEdge, ic to grid%ijkCorn(ic)
3666 !
3667 ! Revision 1.5 2005/06/12 10:56:36 wasistho
3668 ! uncommented second/end TFI procedure
3669 !
3670 ! Revision 1.4 2005/06/12 10:12:01 wasistho
3671 ! commented second/end TFI procedure
3672 !
3673 ! Revision 1.3 2005/06/12 07:59:36 wasistho
3674 ! working version of Nconform1
3675 !
3676 ! Revision 1.19 2005/06/12 06:21:29 wasistho
3677 ! modified dumax in MgFrameCorrectNeighbors
3678 !
3679 ! Revision 1.18 2005/06/12 00:50:11 wasistho
3680 ! fixed bug in defining regNc
3681 !
3682 ! Revision 1.17 2005/06/11 22:57:21 wasistho
3683 ! working version of RFLO_ModMoveGridNconform
3684 !
3685 ! Revision 1.1 2005/06/11 20:59:26 wasistho
3686 ! import as non-conforming partition version of RFLO_ModMoveGridFrame
3687 !
3688 ! Revision 1.13 2005/06/06 23:04:59 wasistho
3689 ! fixed bug put logical test between brackets
3690 !
3691 ! Revision 1.12 2005/06/05 23:03:25 wasistho
3692 ! distinguish external boundary to be fully and partly external
3693 !
3694 ! Revision 1.11 2005/06/04 22:28:06 wasistho
3695 ! more rigorous searching and made alghorithm 1 as default
3696 !
3697 ! Revision 1.10 2005/06/04 10:51:43 wasistho
3698 ! move surface containing partly external-bc
3699 !
3700 ! Revision 1.9 2005/06/04 04:25:44 wasistho
3701 ! fixed bug in determining interior vs external corners
3702 !
3703 ! Revision 1.8 2005/06/04 01:01:33 wasistho
3704 ! distinguished to AMPLIFX,Y,Z
3705 !
3706 ! Revision 1.7 2005/06/03 01:26:40 wasistho
3707 ! moved amplif to affect regCornOld gradually with iteration
3708 !
3709 ! Revision 1.6 2005/06/02 22:59:34 wasistho
3710 ! added user controlled moveGridAmplif and moveGridPower
3711 !
3712 ! Revision 1.5 2005/06/02 19:54:49 wasistho
3713 ! added control parameters amplif and pow
3714 !
3715 ! Revision 1.4 2005/06/01 22:57:33 wasistho
3716 ! commented remeshing
3717 !
3718 ! Revision 1.3 2005/06/01 08:02:39 wasistho
3719 ! increased mgFrame iteration from 5 to 10
3720 !
3721 ! Revision 1.2 2005/06/01 07:14:41 wasistho
3722 ! debuged and made more robust
3723 !
3724 ! Revision 1.1 2005/05/28 08:11:56 wasistho
3725 ! import RFLO_ModMoveGridFrame
3726 !
3727 !
3728 !
3729 ! ******************************************************************************
3730 
3731 
3732 
3733 
3734 
3735 
3736 
3737 
3738 
3739 
3740 
3741 
3742 
3743 
3744 
3745 
3746 
3747 
3748 
rflo_edgedeformation
subroutine rflo_edgedeformation(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
Definition: RFLO_EdgeDeformation.F90:52
ibeg
**********************************************************************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
Definition: RFLO_GetPatchIndices.h:27
rflo_copygeometrydummy
subroutine rflo_copygeometrydummy(region)
Definition: RFLO_CopyGeometryDummy.F90:45
cimg_library::CImg::sum
Tfloat sum() const
Return the sum of all the pixel values in an image.
Definition: CImg.h:13022
jpnbeg
**********************************************************************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
Definition: RFLO_GetDimensPhysNodes.h:27
rflo_calccellcentroids
subroutine rflo_calccellcentroids(region)
Definition: RFLO_CalcCellCentroids.F90:43
rflo_modmovegridframe::rflo_mgframesurfaces
subroutine rflo_mgframesurfaces(regions, someMoved, iType)
Definition: RFLO_ModMoveGridConform.F90:1418
k
j indices k indices k
Definition: Indexing.h:6
rflo_modmovegridframe
Definition: RFLO_ModMoveGridConform.F90:69
rflo_modmovegridframe::rflo_mgframeedges
subroutine rflo_mgframeedges(region, iType, boundMoved, allExternal, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
Definition: RFLO_ModMoveGridConform.F90:1642
rflo_modmovegridframe::rflo_mgframeedgeso
subroutine rflo_mgframeedgeso(region, iType, boundMoved, allExternal, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
Definition: RFLO_ModMoveGridFrame.F90:2048
s
double s
Definition: blastest.C:80
kpcbeg
**********************************************************************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
Definition: RFLO_GetDimensPhys.h:27
max
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:354
rflo_arclengthbounds
subroutine rflo_arclengthbounds(region, xyz, arcLen12, arcLen34, arcLen56)
Definition: RFLO_ArcLengthBounds.F90:48
kpnbeg
**********************************************************************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
Definition: RFLO_GetDimensPhysNodes.h:27
p1
NT p1
Definition: rational_rotation.h:108
rflo_tfint2d
subroutine rflo_tfint2d(s1, s2, s3, s4, e1, e2, e3, e4, p1, p2, p3, p4, xyz)
Definition: RFLO_Tfint.F90:76
rflo_c2eavgcoeffs
subroutine rflo_c2eavgcoeffs(region)
Definition: RFLO_C2eAvgCoeffs.F90:45
rflo_modmovegridframe::rflo_mgframebroadcast
subroutine, public rflo_mgframebroadcast(regions, iselect, iter)
Definition: RFLO_ModMoveGridConform.F90:617
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
rflo_extrapolategeometry
subroutine rflo_extrapolategeometry(region)
Definition: RFLO_ExtrapolateGeometry.F90:43
ic
**********************************************************************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
Definition: RFLO_FindSourceCell.h:27
rflo_modmovegridframe::rflo_movegridframe
subroutine, public rflo_movegridframe(regions)
Definition: RFLO_ModMoveGridConform.F90:127
rflo_exchangednoderecv
subroutine rflo_exchangednoderecv(region, regionSrc, patch, patchSrc, average, dNode)
Definition: RFLO_ExchangeDnodeRecv.F90:51
modgrid::t_grid
Definition: ModGrid.F90:56
rflo_c2favgcoeffs
subroutine rflo_c2favgcoeffs(region)
Definition: RFLO_C2fAvgCoeffs.F90:44
sqrt
double sqrt(double d)
Definition: double.h:73
jpcbeg
**********************************************************************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
Definition: RFLO_GetDimensPhys.h:27
rflo_changeinteriorgrid
subroutine rflo_changeinteriorgrid(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, xyz)
Definition: RFLO_ChangeInteriorGrid.F90:51
ipcend
**********************************************************************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
Definition: RFLO_GetDimensPhys.h:27
rflo_movegridinterfaces
subroutine rflo_movegridinterfaces(regions)
Definition: RFLO_MoveGridInterfaces.F90:45
rflo_calccontrolvolumes
subroutine rflo_calccontrolvolumes(region)
Definition: RFLO_CalcControlVolumes.F90:48
rflo_tfint1d
subroutine rflo_tfint1d(s, p1, p2, xyz)
Definition: RFLO_Tfint.F90:59
jpnend
**********************************************************************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
Definition: RFLO_GetDimensPhysNodes.h:27
rflo_getnodeoffset
subroutine rflo_getnodeoffset(region, iLev, iNodeOffset, ijNodeOffset)
Definition: RFLO_GetDimensions.F90:267
rflo_modmovegridframe::rflo_mgframemovecorners
subroutine rflo_mgframemovecorners(regions)
Definition: RFLO_ModMoveGridConform.F90:1264
patch
Definition: patch.h:74
iend
**********************************************************************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
Definition: RFLO_CalcGradDummySymm.h:32
rflo_calcfacevectors
subroutine rflo_calcfacevectors(region)
Definition: RFLO_CalcFaceVectors.F90:45
rflo_modlaplacesmoothing
Definition: RFLO_ModLaplaceSmoothing.F90:37
ipcbeg
**********************************************************************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
Definition: RFLO_GetDimensPhys.h:27
rflo_exchangegeometry
subroutine rflo_exchangegeometry(regions)
Definition: RFLO_ExchangeGeometry.F90:44
rflo_movegridsurfaces
subroutine rflo_movegridsurfaces(regions, someMoved)
Definition: RFLO_MoveGridSurfaces.F90:46
rflo_generatecoarsegrids
subroutine rflo_generatecoarsegrids(region)
Definition: RFLO_GenerateCoarseGrids.F90:44
rflo_getpatchindicesnodes
subroutine rflo_getpatchindicesnodes(region, patch, iLev, ibeg, iend, jbeg, jend, kbeg, kend)
Definition: RFLO_GetPatchDimens.F90:138
modtools::isnan
logical function isnan(x)
Definition: ModTools.F90:201
rflo_modmovegridframe::rflo_mgframeinterfaces
subroutine rflo_mgframeinterfaces(regions, iType)
Definition: RFLO_ModMoveGridConform.F90:1826
i
blockLoc i
Definition: read.cpp:79
ipnbeg
**********************************************************************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
Definition: RFLO_GetDimensPhysNodes.h:27
x
void int int REAL * x
Definition: read.cpp:74
rflo_getdeformation
subroutine rflo_getdeformation(region, boundMoved, dNode)
Definition: rocstar/RFLO_GetDeformation.F90:44
rflo_modmovegridframe::rflo_mgframesrchneighbors
subroutine, public rflo_mgframesrchneighbors(regions)
Definition: RFLO_ModMoveGridConform.F90:765
rflo_clearsendrequests
subroutine rflo_clearsendrequests(regions, iReg, geometry)
Definition: RFLO_ClearSendRequests.F90:46
rflo_calcgridspeeds
subroutine rflo_calcgridspeeds(region)
Definition: RFLO_CalcGridSpeeds.F90:43
min
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:346
rflo_getdimensphysnodes
subroutine rflo_getdimensphysnodes(region, iLev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend)
Definition: RFLO_GetDimensions.F90:193
j
j indices j
Definition: Indexing.h:6
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 jpcend
Definition: RFLO_GetDimensPhys.h:27
rflo_modmovegridframe::rflo_mgframebnddeformation0
subroutine rflo_mgframebnddeformation0(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
Definition: RFLO_ModMoveGridFrame.F90:3382
jend
**********************************************************************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
Definition: RFLO_CalcGradDummySymm.h:32
rflo_exchangednodecopy
subroutine rflo_exchangednodecopy(region, regionSrc, patch, patchSrc, average, dNode, dNodeSrc)
Definition: RFLO_ExchangeDnodeCopy.F90:54
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
jbeg
**********************************************************************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
Definition: RFLO_CalcGradDummySymm.h:32
rflo_boundarydeformation
subroutine rflo_boundarydeformation(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
Definition: RFLO_BoundaryDeformation.F90:50
dist
long double dist(long double *coord1, long double *coord2, int size)
Definition: utilities/rc_cmp/util.cpp:305
rflo_modmovegridframe::rflo_mgframerestoreexternal
subroutine rflo_mgframerestoreexternal(region)
Definition: RFLO_ModMoveGridConform.F90:1556
rflo_modmovegridframe::rflo_mgframebnddeformation
subroutine rflo_mgframebnddeformation(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, dNode)
Definition: RFLO_ModMoveGridConform.F90:1986
setup_py::grid
subroutine grid(bp)
Definition: setup_py.f90:257
kbeg
**********************************************************************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
Definition: RFLO_CalcGradDummySymm.h:32
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
ipnend
**********************************************************************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
Definition: RFLO_GetDimensPhysNodes.h:27
rflo_exchangednodesend
subroutine rflo_exchangednodesend(region, regionSrc, patch, dNode)
Definition: RFLO_ExchangeDnodeSend.F90:48
rflo_checkmetrics
subroutine rflo_checkmetrics(iReg, region)
Definition: RFLO_CheckMetrics.F90:45
rflo_getdimensphys
subroutine rflo_getdimensphys(region, iLev, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend)
Definition: RFLO_GetDimensions.F90:109
Line_2::a
RT a() const
Definition: Line_2.h:140
rflo_laplacegridsmoo
subroutine rflo_laplacegridsmoo(regions, resid)
Definition: RFLO_LaplaceGridSmoo.F90:45
rflo_calcfacecentroids
subroutine rflo_calcfacecentroids(region)
Definition: RFLO_CalcFaceCentroids.F90:42
modbndpatch::t_patch
Definition: ModBndPatch.F90:91
rflo_modmovegridframe::rflo_mgframecornpoints
subroutine, public rflo_mgframecornpoints(regions)
Definition: RFLO_ModMoveGridConform.F90:398
rflo_modmovegridframe::rflo_mgframecorrectneighbors
subroutine rflo_mgframecorrectneighbors(regions)
Definition: RFLO_ModMoveGridConform.F90:1117