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