Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLO_ChangeInteriorGrid.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: redistribute the interior grid based on new discretization
26 ! of the boundaries.
27 !
28 ! Description: the method used is linear transfinite interpolation (TFI).
29 !
30 ! Input: region = grid dimensions
31 ! boundMoved = flag for boundaries of a region which have moved
32 ! edgeMoved = flag for edges whose nodes have moved
33 ! arcLen12 = arclength between i=const. boundaries for each j, k
34 ! arcLen34 = arclength between j=const. boundaries for each k, i
35 ! arcLen56 = arclength between k=const. boundaries for each i, j
36 ! xyzOld = grid from previous time step
37 ! xyz = deformations at the boundaries of region.
38 !
39 ! Output: xyz = new grid.
40 !
41 ! Notes: none.
42 !
43 !******************************************************************************
44 !
45 ! $Id: RFLO_ChangeInteriorGrid.F90,v 1.4 2008/12/06 08:44:06 mtcampbe Exp $
46 !
47 ! Copyright: (c) 2001 by the University of Illinois
48 !
49 !******************************************************************************
50 
51 SUBROUTINE rflo_changeinteriorgrid( region,boundMoved,edgeMoved, &
52  arclen12,arclen34,arclen56,xyzold,xyz )
53 
54  USE moddatatypes
55  USE moddatastruct, ONLY : t_region
56  USE modinterfaces, ONLY : rflo_getdimensphysnodes, rflo_getnodeoffset
57  USE moderror
58  USE modparameters
59  IMPLICIT NONE
60 
61 #include "Indexing.h"
62 
63 ! ... parameters
64  LOGICAL :: boundmoved(6), edgemoved(12)
65 
66  REAL(RFREAL), POINTER :: arclen12(:,:), arclen34(:,:), arclen56(:,:)
67  REAL(RFREAL), POINTER :: xyz(:,:), xyzold(:,:)
68 
69  TYPE(t_region) :: region
70 
71 ! ... loop variables
72  INTEGER :: i, j, k
73 
74 ! ... local variables
75  INTEGER :: ilev, ipnbeg, ipnend, jpnbeg, jpnend, kpnbeg, kpnend
76  INTEGER :: ijkn, imjkn, ijmkn, ijkmn, inoff, ijnoff, errorflag
77 
78  REAL(RFREAL) :: phii, phii1, phij, phij1, phik, phik1, dsi
79  REAL(RFREAL) :: v1(3), v2(3), v3(3), v12(3), v13(3), v23(3), v123(3)
80  REAL(RFREAL), ALLOCATABLE :: dsj(:), dsk(:,:)
81 
82 !******************************************************************************
83 
84  CALL registerfunction( region%global,'RFLO_ChangeInteriorGrid',&
85  'RFLO_ChangeInteriorGrid.F90' )
86 
87 ! get dimensions, allocate temporary storage ----------------------------------
88 
89  ilev = 1
90  CALL rflo_getdimensphysnodes( region,ilev,ipnbeg,ipnend, &
91  jpnbeg,jpnend,kpnbeg,kpnend )
92  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )
93 
94  ALLOCATE( dsj(ipnbeg:ipnend) ,stat=errorflag )
95  ALLOCATE( dsk(ipnbeg:ipnend,jpnbeg:jpnend),stat=errorflag )
96  region%global%error = errorflag
97  IF (region%global%error /= 0) &
98  CALL errorstop( region%global,err_allocate,&
99  __line__ )
100 
101 ! interpolate displacements inside region -------------------------------------
102 
103  dsk(:,:) = 0._rfreal
104  DO k=kpnbeg+1,kpnend-1
105  dsj(:) = 0._rfreal
106  DO j=jpnbeg+1,jpnend-1
107  dsi = 0._rfreal
108  DO i=ipnbeg+1,ipnend-1
109  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
110  imjkn = indijk(i-1,j ,k ,inoff,ijnoff)
111  ijmkn = indijk(i ,j-1,k ,inoff,ijnoff)
112  ijkmn = indijk(i ,j ,k-1,inoff,ijnoff)
113 
114  dsi = dsi + &
115  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,imjkn))**2 + &
116  (xyzold(ycoord,ijkn)-xyzold(ycoord,imjkn))**2 + &
117  (xyzold(zcoord,ijkn)-xyzold(zcoord,imjkn))**2)
118  dsj(i) = dsj(i) + &
119  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijmkn))**2 + &
120  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijmkn))**2 + &
121  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijmkn))**2)
122  dsk(i,j) = dsk(i,j) + &
123  sqrt((xyzold(xcoord,ijkn)-xyzold(xcoord,ijkmn))**2 + &
124  (xyzold(ycoord,ijkn)-xyzold(ycoord,ijkmn))**2 + &
125  (xyzold(zcoord,ijkn)-xyzold(zcoord,ijkmn))**2)
126 
127  phii = dsi/arclen12(j,k)
128  phii1 = 1._rfreal - phii
129  phij = dsj(i)/arclen34(k,i)
130  phij1 = 1._rfreal - phij
131  phik = dsk(i,j)/arclen56(i,j)
132  phik1 = 1._rfreal - phik
133 
134  v1(:) = phii1*xyz(:,indijk(ipnbeg,j,k,inoff,ijnoff)) + &
135  phii *xyz(:,indijk(ipnend,j,k,inoff,ijnoff))
136  v2(:) = phij1*xyz(:,indijk(i,jpnbeg,k,inoff,ijnoff)) + &
137  phij *xyz(:,indijk(i,jpnend,k,inoff,ijnoff))
138  v3(:) = phik1*xyz(:,indijk(i,j,kpnbeg,inoff,ijnoff)) + &
139  phik *xyz(:,indijk(i,j,kpnend,inoff,ijnoff))
140 
141  v12(:) = phii1*phij1*xyz(:,indijk(ipnbeg,jpnbeg,k,inoff,ijnoff)) + &
142  phii1*phij *xyz(:,indijk(ipnbeg,jpnend,k,inoff,ijnoff)) + &
143  phii *phij1*xyz(:,indijk(ipnend,jpnbeg,k,inoff,ijnoff)) + &
144  phii *phij *xyz(:,indijk(ipnend,jpnend,k,inoff,ijnoff))
145  v13(:) = phii1*phik1*xyz(:,indijk(ipnbeg,j,kpnbeg,inoff,ijnoff)) + &
146  phii1*phik *xyz(:,indijk(ipnbeg,j,kpnend,inoff,ijnoff)) + &
147  phii *phik1*xyz(:,indijk(ipnend,j,kpnbeg,inoff,ijnoff)) + &
148  phii *phik *xyz(:,indijk(ipnend,j,kpnend,inoff,ijnoff))
149  v23(:) = phij1*phik1*xyz(:,indijk(i,jpnbeg,kpnbeg,inoff,ijnoff)) + &
150  phij1*phik *xyz(:,indijk(i,jpnbeg,kpnend,inoff,ijnoff)) + &
151  phij *phik1*xyz(:,indijk(i,jpnend,kpnbeg,inoff,ijnoff)) + &
152  phij *phik *xyz(:,indijk(i,jpnend,kpnend,inoff,ijnoff))
153 
154  v123(:) = phii1*phij1*phik1* &
155  xyz(:,indijk(ipnbeg,jpnbeg,kpnbeg,inoff,ijnoff)) + &
156  phii1*phij1*phik * &
157  xyz(:,indijk(ipnbeg,jpnbeg,kpnend,inoff,ijnoff)) + &
158  phii1*phij *phik1* &
159  xyz(:,indijk(ipnbeg,jpnend,kpnbeg,inoff,ijnoff)) + &
160  phii *phij1*phik1* &
161  xyz(:,indijk(ipnend,jpnbeg,kpnbeg,inoff,ijnoff)) + &
162  phii1*phij *phik * &
163  xyz(:,indijk(ipnbeg,jpnend,kpnend,inoff,ijnoff)) + &
164  phii *phij1*phik * &
165  xyz(:,indijk(ipnend,jpnbeg,kpnend,inoff,ijnoff)) + &
166  phii *phij *phik1* &
167  xyz(:,indijk(ipnend,jpnend,kpnbeg,inoff,ijnoff)) + &
168  phii *phij *phik * &
169  xyz(:,indijk(ipnend,jpnend,kpnend,inoff,ijnoff))
170 
171  xyz(:,ijkn) = v1(:) + v2(:) + v3(:) - v12(:) - v13(:) - v23(:) + v123(:)
172  ENDDO ! i
173  ENDDO ! j
174  ENDDO ! k
175 
176 ! move grid -------------------------------------------------------------------
177 
178  DO k=kpnbeg,kpnend
179  DO j=jpnbeg,jpnend
180  DO i=ipnbeg,ipnend
181  ijkn = indijk(i,j,k,inoff,ijnoff)
182  xyz(xcoord,ijkn) = region%levels(1)%gridOld%xyz(xcoord,ijkn) + &
183  xyz(xcoord,ijkn)
184  xyz(ycoord,ijkn) = region%levels(1)%gridOld%xyz(ycoord,ijkn) + &
185  xyz(ycoord,ijkn)
186  xyz(zcoord,ijkn) = region%levels(1)%gridOld%xyz(zcoord,ijkn) + &
187  xyz(zcoord,ijkn)
188  ENDDO
189  ENDDO
190  ENDDO
191 
192 ! finalize --------------------------------------------------------------------
193 
194  DEALLOCATE( dsj,stat=errorflag )
195  DEALLOCATE( dsk,stat=errorflag )
196  region%global%error = errorflag
197  IF (region%global%error /= 0) &
198  CALL errorstop( region%global,err_deallocate,&
199  __line__ )
200 
201  CALL deregisterfunction( region%global )
202 
203 END SUBROUTINE rflo_changeinteriorgrid
204 
205 !******************************************************************************
206 !
207 ! RCS Revision history:
208 !
209 ! $Log: RFLO_ChangeInteriorGrid.F90,v $
210 ! Revision 1.4 2008/12/06 08:44:06 mtcampbe
211 ! Updated license.
212 !
213 ! Revision 1.3 2008/11/19 22:17:20 mtcampbe
214 ! Added Illinois Open Source License/Copyright
215 !
216 ! Revision 1.2 2006/03/05 19:04:15 wasistho
217 ! set computational space coordinates from initial grid
218 !
219 ! Revision 1.1 2004/11/29 21:25:16 wasistho
220 ! lower to upper case
221 !
222 ! Revision 1.8 2003/11/20 16:40:34 mdbrandy
223 ! Backing out RocfluidMP changes from 11-17-03
224 !
225 ! Revision 1.5 2003/05/15 02:57:01 jblazek
226 ! Inlined index function.
227 !
228 ! Revision 1.4 2003/03/14 22:05:10 jblazek
229 ! Improved mesh motion algorithm - node movement exchaged between blocks.
230 !
231 ! Revision 1.3 2002/10/12 03:20:50 jblazek
232 ! Replaced [io]stat=global%error with local errorFlag for Rocflo.
233 !
234 ! Revision 1.2 2002/09/05 17:40:19 jblazek
235 ! Variable global moved into regions().
236 !
237 ! Revision 1.1 2002/08/15 19:48:05 jblazek
238 ! Implemented grid deformation capability.
239 !
240 !******************************************************************************
241 
242 
243 
244 
245 
246 
247 
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
k
j indices k indices k
Definition: Indexing.h:6
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
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
sqrt
double sqrt(double d)
Definition: double.h:73
rflo_changeinteriorgrid
subroutine rflo_changeinteriorgrid(region, boundMoved, edgeMoved, arcLen12, arcLen34, arcLen56, xyzOld, xyz)
Definition: RFLO_ChangeInteriorGrid.F90:51
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
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
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
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
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