Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLO_ResidualSmoothing.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: conduct implicit residual smoothing (central form).
26 !
27 ! Description: none.
28 !
29 ! Input: region = region data (residual, smoothing coeff., temporary array)
30 !
31 ! Output: region%levels%mixt%rhs = smoothed residual.
32 !
33 ! Notes: none.
34 !
35 !******************************************************************************
36 !
37 ! $Id: RFLO_ResidualSmoothing.F90,v 1.3 2008/12/06 08:44:27 mtcampbe Exp $
38 !
39 ! Copyright: (c) 2001 by the University of Illinois
40 !
41 !******************************************************************************
42 
43 SUBROUTINE rflo_residualsmoothing( region )
44 
45  USE moddatatypes
46  USE moddatastruct, ONLY : t_region
47  USE modinterfaces, ONLY : rflo_getdimensphys, rflo_getcelloffset
48  USE moderror
49  USE modparameters
50  IMPLICIT NONE
51 
52 #include "Indexing.h"
53 
54 ! ... parameters
55  TYPE(t_region) :: region
56 
57 ! ... loop variables
58  INTEGER :: i, j, k
59 
60 ! ... local variables
61  INTEGER :: ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
62  INTEGER :: ilev, icoff, ijcoff, off1d, ijkc, ijkc1, ijdum, ijdum1
63  INTEGER :: im1, jm1, km1, ip1, jp1, kp1
64 
65  REAL(RFREAL) :: t
66  REAL(RFREAL), POINTER :: rhs(:,:), epsirs(:,:), d(:)
67 
68 !******************************************************************************
69 
70  CALL registerfunction( region%global,'RFLO_ResidualSmoothing',&
71  'RFLO_ResidualSmoothing.F90' )
72 
73 ! get dimensions and pointers
74 
75  ilev = region%currLevel
76 
77  CALL rflo_getdimensphys( region,ilev,ipcbeg,ipcend,jpcbeg,jpcend, &
78  kpcbeg,kpcend )
79  CALL rflo_getcelloffset( region,ilev,icoff,ijcoff )
80 
81  epsirs => region%levels(ilev)%mixt%epsIrs
82  rhs => region%levels(ilev)%mixt%rhs
83  d => region%work1D
84 
85 ! solution of tridiagonal system in I-direction
86 
87  DO k=kpcbeg,kpcend
88 
89  i = ipcbeg - 1
90  off1d = ipcend + 1
91  DO j=jpcbeg,jpcend
92  ijdum = indij(i,j,off1d) + 1
93  d(ijdum) = 0._rfreal
94  ENDDO
95 
96  DO i=ipcbeg,ipcend
97  im1 = i - 1
98  DO j=jpcbeg,jpcend
99  ijkc = indijk(i ,j,k,icoff,ijcoff)
100  ijkc1 = indijk(im1,j,k,icoff,ijcoff)
101  ijdum = indij(i ,j,off1d) + 1
102  ijdum1 = indij(im1,j,off1d) + 1
103  t = 1._rfreal/(1._rfreal+2._rfreal*epsirs(icoord,ijkc)- &
104  epsirs(icoord,ijkc)*d(ijdum1))
105  d(ijdum) = t*epsirs(icoord,ijkc)
106 
107  rhs(cv_mixt_dens,ijkc) = t*(rhs(cv_mixt_dens,ijkc) + &
108  epsirs(icoord,ijkc)*rhs(cv_mixt_dens,ijkc1))
109  rhs(cv_mixt_xmom,ijkc) = t*(rhs(cv_mixt_xmom,ijkc) + &
110  epsirs(icoord,ijkc)*rhs(cv_mixt_xmom,ijkc1))
111  rhs(cv_mixt_ymom,ijkc) = t*(rhs(cv_mixt_ymom,ijkc) + &
112  epsirs(icoord,ijkc)*rhs(cv_mixt_ymom,ijkc1))
113  rhs(cv_mixt_zmom,ijkc) = t*(rhs(cv_mixt_zmom,ijkc) + &
114  epsirs(icoord,ijkc)*rhs(cv_mixt_zmom,ijkc1))
115  rhs(cv_mixt_ener,ijkc) = t*(rhs(cv_mixt_ener,ijkc) + &
116  epsirs(icoord,ijkc)*rhs(cv_mixt_ener,ijkc1))
117  ENDDO
118  ENDDO
119 
120  DO i=ipcend-1,ipcbeg,-1
121  ip1 = i + 1
122  DO j=jpcbeg,jpcend
123  ijkc = indijk(i ,j,k,icoff,ijcoff)
124  ijkc1 = indijk(ip1,j,k,icoff,ijcoff)
125  ijdum = indij(i,j,off1d) + 1
126 
127  rhs(cv_mixt_dens,ijkc) = rhs(cv_mixt_dens,ijkc) + &
128  d(ijdum)*rhs(cv_mixt_dens,ijkc1)
129  rhs(cv_mixt_xmom,ijkc) = rhs(cv_mixt_xmom,ijkc) + &
130  d(ijdum)*rhs(cv_mixt_xmom,ijkc1)
131  rhs(cv_mixt_ymom,ijkc) = rhs(cv_mixt_ymom,ijkc) + &
132  d(ijdum)*rhs(cv_mixt_ymom,ijkc1)
133  rhs(cv_mixt_zmom,ijkc) = rhs(cv_mixt_zmom,ijkc) + &
134  d(ijdum)*rhs(cv_mixt_zmom,ijkc1)
135  rhs(cv_mixt_ener,ijkc) = rhs(cv_mixt_ener,ijkc) + &
136  d(ijdum)*rhs(cv_mixt_ener,ijkc1)
137  ENDDO
138  ENDDO
139 
140  ENDDO ! k
141 
142 ! solution of tridiagonal system in J-direction
143 
144  DO k=kpcbeg,kpcend
145 
146  j = jpcbeg - 1
147  off1d = jpcend + 1
148  DO i=ipcbeg,ipcend
149  ijdum = indij(j,i,off1d) + 1
150  d(ijdum) = 0._rfreal
151  ENDDO
152 
153  DO j=jpcbeg,jpcend
154  jm1 = j - 1
155  DO i=ipcbeg,ipcend
156  ijkc = indijk(i,j ,k,icoff,ijcoff)
157  ijkc1 = indijk(i,jm1,k,icoff,ijcoff)
158  ijdum = indij(j ,i,off1d) + 1
159  ijdum1 = indij(jm1,i,off1d) + 1
160  t = 1._rfreal/(1._rfreal+2._rfreal*epsirs(jcoord,ijkc)- &
161  epsirs(jcoord,ijkc)*d(ijdum1))
162  d(ijdum) = t*epsirs(jcoord,ijkc)
163 
164  rhs(cv_mixt_dens,ijkc) = t*(rhs(cv_mixt_dens,ijkc) + &
165  epsirs(jcoord,ijkc)*rhs(cv_mixt_dens,ijkc1))
166  rhs(cv_mixt_xmom,ijkc) = t*(rhs(cv_mixt_xmom,ijkc) + &
167  epsirs(jcoord,ijkc)*rhs(cv_mixt_xmom,ijkc1))
168  rhs(cv_mixt_ymom,ijkc) = t*(rhs(cv_mixt_ymom,ijkc) + &
169  epsirs(jcoord,ijkc)*rhs(cv_mixt_ymom,ijkc1))
170  rhs(cv_mixt_zmom,ijkc) = t*(rhs(cv_mixt_zmom,ijkc) + &
171  epsirs(jcoord,ijkc)*rhs(cv_mixt_zmom,ijkc1))
172  rhs(cv_mixt_ener,ijkc) = t*(rhs(cv_mixt_ener,ijkc) + &
173  epsirs(jcoord,ijkc)*rhs(cv_mixt_ener,ijkc1))
174  ENDDO
175  ENDDO
176 
177  DO j=jpcend-1,jpcbeg,-1
178  jp1 = j + 1
179  DO i=ipcbeg,ipcend
180  ijkc = indijk(i,j ,k,icoff,ijcoff)
181  ijkc1 = indijk(i,jp1,k,icoff,ijcoff)
182  ijdum = indij(j,i,off1d) + 1
183 
184  rhs(cv_mixt_dens,ijkc) = rhs(cv_mixt_dens,ijkc) + &
185  d(ijdum)*rhs(cv_mixt_dens,ijkc1)
186  rhs(cv_mixt_xmom,ijkc) = rhs(cv_mixt_xmom,ijkc) + &
187  d(ijdum)*rhs(cv_mixt_xmom,ijkc1)
188  rhs(cv_mixt_ymom,ijkc) = rhs(cv_mixt_ymom,ijkc) + &
189  d(ijdum)*rhs(cv_mixt_ymom,ijkc1)
190  rhs(cv_mixt_zmom,ijkc) = rhs(cv_mixt_zmom,ijkc) + &
191  d(ijdum)*rhs(cv_mixt_zmom,ijkc1)
192  rhs(cv_mixt_ener,ijkc) = rhs(cv_mixt_ener,ijkc) + &
193  d(ijdum)*rhs(cv_mixt_ener,ijkc1)
194  ENDDO
195  ENDDO
196 
197  ENDDO ! k
198 
199 ! solution of tridiagonal system in K-direction
200 
201  DO j=jpcbeg,jpcend
202 
203  k = kpcbeg - 1
204  off1d = kpcend + 1
205  DO i=ipcbeg,ipcend
206  ijdum = indij(k,i,off1d) + 1
207  d(ijdum) = 0._rfreal
208  ENDDO
209 
210  DO k=kpcbeg,kpcend
211  km1 = k - 1
212  DO i=ipcbeg,ipcend
213  ijkc = indijk(i,j,k ,icoff,ijcoff)
214  ijkc1 = indijk(i,j,km1,icoff,ijcoff)
215  ijdum = indij(k ,i,off1d) + 1
216  ijdum1 = indij(km1,i,off1d) + 1
217  t = 1._rfreal/(1._rfreal+2._rfreal*epsirs(kcoord,ijkc)- &
218  epsirs(kcoord,ijkc)*d(ijdum1))
219  d(ijdum) = t*epsirs(kcoord,ijkc)
220 
221  rhs(cv_mixt_dens,ijkc) = t*(rhs(cv_mixt_dens,ijkc) + &
222  epsirs(kcoord,ijkc)*rhs(cv_mixt_dens,ijkc1))
223  rhs(cv_mixt_xmom,ijkc) = t*(rhs(cv_mixt_xmom,ijkc) + &
224  epsirs(kcoord,ijkc)*rhs(cv_mixt_xmom,ijkc1))
225  rhs(cv_mixt_ymom,ijkc) = t*(rhs(cv_mixt_ymom,ijkc) + &
226  epsirs(kcoord,ijkc)*rhs(cv_mixt_ymom,ijkc1))
227  rhs(cv_mixt_zmom,ijkc) = t*(rhs(cv_mixt_zmom,ijkc) + &
228  epsirs(kcoord,ijkc)*rhs(cv_mixt_zmom,ijkc1))
229  rhs(cv_mixt_ener,ijkc) = t*(rhs(cv_mixt_ener,ijkc) + &
230  epsirs(kcoord,ijkc)*rhs(cv_mixt_ener,ijkc1))
231  ENDDO
232  ENDDO
233 
234  DO k=kpcend-1,kpcbeg,-1
235  kp1 = k + 1
236  DO i=ipcbeg,ipcend
237  ijkc = indijk(i,j,k ,icoff,ijcoff)
238  ijkc1 = indijk(i,j,kp1,icoff,ijcoff)
239  ijdum = indij(k,i,off1d) + 1
240 
241  rhs(cv_mixt_dens,ijkc) = rhs(cv_mixt_dens,ijkc) + &
242  d(ijdum)*rhs(cv_mixt_dens,ijkc1)
243  rhs(cv_mixt_xmom,ijkc) = rhs(cv_mixt_xmom,ijkc) + &
244  d(ijdum)*rhs(cv_mixt_xmom,ijkc1)
245  rhs(cv_mixt_ymom,ijkc) = rhs(cv_mixt_ymom,ijkc) + &
246  d(ijdum)*rhs(cv_mixt_ymom,ijkc1)
247  rhs(cv_mixt_zmom,ijkc) = rhs(cv_mixt_zmom,ijkc) + &
248  d(ijdum)*rhs(cv_mixt_zmom,ijkc1)
249  rhs(cv_mixt_ener,ijkc) = rhs(cv_mixt_ener,ijkc) + &
250  d(ijdum)*rhs(cv_mixt_ener,ijkc1)
251  ENDDO
252  ENDDO
253 
254  ENDDO ! j
255 
256 ! finalize
257 
258  CALL deregisterfunction( region%global )
259 
260 END SUBROUTINE rflo_residualsmoothing
261 
262 !******************************************************************************
263 !
264 ! RCS Revision history:
265 !
266 ! $Log: RFLO_ResidualSmoothing.F90,v $
267 ! Revision 1.3 2008/12/06 08:44:27 mtcampbe
268 ! Updated license.
269 !
270 ! Revision 1.2 2008/11/19 22:17:38 mtcampbe
271 ! Added Illinois Open Source License/Copyright
272 !
273 ! Revision 1.1 2004/11/29 20:51:40 wasistho
274 ! lower to upper case
275 !
276 ! Revision 1.10 2003/11/20 16:40:40 mdbrandy
277 ! Backing out RocfluidMP changes from 11-17-03
278 !
279 ! Revision 1.6 2003/05/15 02:57:04 jblazek
280 ! Inlined index function.
281 !
282 ! Revision 1.5 2003/01/10 17:58:43 jblazek
283 ! Added missing explicit interfaces.
284 !
285 ! Revision 1.4 2002/09/05 17:40:22 jblazek
286 ! Variable global moved into regions().
287 !
288 ! Revision 1.3 2002/02/21 23:25:06 jblazek
289 ! Blocks renamed as regions.
290 !
291 ! Revision 1.2 2002/02/09 01:47:01 jblazek
292 ! Added multi-probe option, residual smoothing, physical time step.
293 !
294 ! Revision 1.1 2002/01/23 03:51:25 jblazek
295 ! Added low-level time-stepping routines.
296 !
297 !******************************************************************************
298 
299 
300 
301 
302 
303 
304 
d
const NT & d
Definition: rational_rotation.h:73
k
j indices k indices k
Definition: Indexing.h:6
rhs
NT rhs
Definition: rational_rotation.h:86
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
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
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
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
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
i
blockLoc i
Definition: read.cpp:79
rflo_getcelloffset
subroutine rflo_getcelloffset(region, iLev, iCellOffset, ijCellOffset)
Definition: RFLO_GetDimensions.F90:235
rflo_residualsmoothing
subroutine rflo_residualsmoothing(region)
Definition: RFLO_ResidualSmoothing.F90:43
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
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflo_getdimensphys
subroutine rflo_getdimensphys(region, iLev, ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend)
Definition: RFLO_GetDimensions.F90:109