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