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