Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLO_ModFiniteDifference.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 finite difference routines.
26 !
27 ! Description: None.
28 !
29 ! ******************************************************************************
30 !
31 ! $Id: RFLO_ModFiniteDifference.F90,v 1.4 2008/12/06 08:44:16 mtcampbe Exp $
32 !
33 ! Copyright: (c) 2004 by the University of Illinois
34 !
35 ! ******************************************************************************
36 
38 
39  USE modglobal, ONLY : t_global
40  USE moddatastruct, ONLY: t_region
41  USE modgrid, ONLY : t_grid
42  USE modbndpatch, ONLY : t_patch
43  USE modparameters
44  USE moddatatypes
45  USE moderror
46  USE modmpi
47 
48  IMPLICIT NONE
49 
50  PRIVATE
51  PUBLIC :: rflo_findiffcompi, &
61 
62 ! private :
63 
64 ! ******************************************************************************
65 ! Declarations and definitions
66 ! ******************************************************************************
67 
68  CHARACTER(CHRLEN) :: RCSIdentString = &
69  '$RCSfile: RFLO_ModFiniteDifference.F90,v $ $Revision: 1.4 $'
70 
71 ! ******************************************************************************
72 ! Routines
73 ! ******************************************************************************
74 
75  CONTAINS
76 
77 !******************************************************************************
78 !
79 ! Purpose: perform 1st derivative finite difference in I-direction in
80 ! computational space
81 !
82 ! Description: based on 2nd order central differencing
83 !
84 ! Input: ibeg, iend, jbeg, jend, kbeg, kend = region range indices
85 ! iNOff = i-stride
86 ! ijNOff = ij-stride
87 ! idb, ide = begin and end indexing of first dimension of var(:,:)
88 ! var = real variable to be extrapolated
89 !
90 ! Output: dvar = resulting derivative
91 !
92 ! Notes: none.
93 !
94 !******************************************************************************
95 
96 SUBROUTINE rflo_findiffcompi( ibeg,iend,jbeg,jend,kbeg,kend,ndum, &
97  inoff,ijnoff,idb,ide,var,dvar )
98 
99  IMPLICIT NONE
100 
101 #include "Indexing.h"
102 
103 ! ... parameters
104  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ndum, idb, ide, inoff, ijnoff
105  REAL(RFREAL), POINTER :: var(:,:), dvar(:,:)
106 
107 ! ... loop variables
108  INTEGER :: i, j, k
109 
110 ! ... local variables
111  INTEGER :: nelm, ndim, ijkn, ijknp, ijknm, ijkn1, ijkn2, error
112  REAL(RFREAL) :: dh, r2dh
113 
114 !******************************************************************************
115 
116  nelm = ide-idb+1
117  ndim = (iend-ibeg+1)*(jend-jbeg+1)*(kend-kbeg+1)
118 
119  IF ((SIZE( var,1 ) < nelm) .OR. (SIZE( var,2 ) /= ndim)) THEN
120  WRITE(stderr,'(A)') solver_name
121  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompI: '
122  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
123  WRITE(stderr,'(A)') solver_name
124 #ifdef MPI
125  CALL mpi_abort( error )
126 #endif
127  stop
128  ENDIF
129 
130  dh = 1._rfreal/REAL( iend-ibeg-2*ndum )
131  r2dh = 0.5_rfreal/dh
132 
133  DO k=kbeg,kend
134  DO j=jbeg,jend
135  DO i=ibeg+1,iend-1
136  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
137  ijknp = indijk(i+1 ,j ,k ,inoff,ijnoff)
138  ijknm = indijk(i-1 ,j ,k ,inoff,ijnoff)
139  dvar(idb:ide,ijkn) = (var(idb:ide,ijknp) - var(idb:ide,ijknm))*r2dh
140  ENDDO
141  DO i=ibeg,ibeg
142  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
143  ijkn1 = indijk(i+1 ,j ,k ,inoff,ijnoff)
144  ijkn2 = indijk(i+2 ,j ,k ,inoff,ijnoff)
145  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
146  ENDDO
147  DO i=iend,iend
148  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
149  ijkn1 = indijk(i-1 ,j ,k ,inoff,ijnoff)
150  ijkn2 = indijk(i-2 ,j ,k ,inoff,ijnoff)
151  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
152  ENDDO
153  ENDDO
154  ENDDO
155 
156 ! finalize --------------------------------------------------------------------
157 
158 END SUBROUTINE rflo_findiffcompi
159 
160 
161 !******************************************************************************
162 !
163 ! Purpose: perform 1st derivative finite difference in J-direction in
164 ! computational space
165 !
166 ! Description: based on 2nd order central differencing
167 !
168 ! Input: ibeg, iend, jbeg, jend, kbeg, kend = region range indices
169 ! iNOff = i-stride
170 ! ijNOff = ij-stride
171 ! idb, ide = begin and end indexing of first dimension of var(:,:)
172 ! var = real variable to be extrapolated
173 !
174 ! Output: dvar = resulting derivative
175 !
176 ! Notes: none.
177 !
178 !******************************************************************************
179 
180 SUBROUTINE rflo_findiffcompj( ibeg,iend,jbeg,jend,kbeg,kend,ndum, &
181  inoff,ijnoff,idb,ide,var,dvar )
182 
183  IMPLICIT NONE
184 
185 #include "Indexing.h"
186 
187 ! ... parameters
188  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ndum, idb, ide, inoff, ijnoff
189  REAL(RFREAL), POINTER :: var(:,:), dvar(:,:)
190 
191 ! ... loop variables
192  INTEGER :: i, j, k
193 
194 ! ... local variables
195  INTEGER :: nelm, ndim, ijkn, ijknp, ijknm, ijkn1, ijkn2, error
196  REAL(RFREAL) :: dh, r2dh
197 
198 !******************************************************************************
199 
200  nelm = ide-idb+1
201  ndim = (iend-ibeg+1)*(jend-jbeg+1)*(kend-kbeg+1)
202 
203  IF ((SIZE( var,1 ) < nelm) .OR. (SIZE( var,2 ) /= ndim)) THEN
204  WRITE(stderr,'(A)') solver_name
205  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompJ: '
206  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
207  WRITE(stderr,'(A)') solver_name
208 #ifdef MPI
209  CALL mpi_abort( error )
210 #endif
211  stop
212  ENDIF
213 
214  dh = 1._rfreal/REAL( jend-jbeg-2*ndum )
215  r2dh = 0.5_rfreal/dh
216 
217  DO k=kbeg,kend
218  DO j=jbeg+1,jend-1
219  DO i=ibeg,iend
220  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
221  ijknp = indijk(i ,j+1 ,k ,inoff,ijnoff)
222  ijknm = indijk(i ,j-1 ,k ,inoff,ijnoff)
223  dvar(idb:ide,ijkn) = (var(idb:ide,ijknp) - var(idb:ide,ijknm))*r2dh
224  ENDDO
225  ENDDO
226  ENDDO
227 
228  DO i=ibeg,iend
229  DO k=kbeg,kend
230  DO j=jbeg,jbeg
231  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
232  ijkn1 = indijk(i ,j+1 ,k ,inoff,ijnoff)
233  ijkn2 = indijk(i ,j+2 ,k ,inoff,ijnoff)
234  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
235  ENDDO
236  DO j=jend,jend
237  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
238  ijkn1 = indijk(i ,j-1 ,k ,inoff,ijnoff)
239  ijkn2 = indijk(i ,j-2 ,k ,inoff,ijnoff)
240  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
241  ENDDO
242  ENDDO
243  ENDDO
244 
245 ! finalize --------------------------------------------------------------------
246 
247 END SUBROUTINE rflo_findiffcompj
248 
249 
250 !******************************************************************************
251 !
252 ! Purpose: perform 1st derivative finite difference in K-direction in
253 ! computational space
254 !
255 ! Description: based on 2nd order central differencing
256 !
257 ! Input: ibeg, iend, jbeg, jend, kbeg, kend = region range indices
258 ! iNOff = i-stride
259 ! ijNOff = ij-stride
260 ! idb, ide = begin and end indexing of first dimension of var(:,:)
261 ! var = real variable to be extrapolated
262 !
263 ! Output: dvar = resulting derivative
264 !
265 ! Notes: none.
266 !
267 !******************************************************************************
268 
269 SUBROUTINE rflo_findiffcompk( ibeg,iend,jbeg,jend,kbeg,kend,ndum, &
270  inoff,ijnoff,idb,ide,var,dvar )
271 
272  IMPLICIT NONE
273 
274 #include "Indexing.h"
275 
276 ! ... parameters
277  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ndum, idb, ide, inoff, ijnoff
278  REAL(RFREAL), POINTER :: var(:,:), dvar(:,:)
279 
280 ! ... loop variables
281  INTEGER :: i, j, k
282 
283 ! ... local variables
284  INTEGER :: nelm, ndim, ijkn, ijknp, ijknm, ijkn1, ijkn2, error
285  REAL(RFREAL) :: dh, r2dh
286 
287 !******************************************************************************
288 
289  nelm = ide-idb+1
290  ndim = (iend-ibeg+1)*(jend-jbeg+1)*(kend-kbeg+1)
291 
292  IF ((SIZE( var,1 ) < nelm) .OR. (SIZE( var,2 ) /= ndim)) THEN
293  WRITE(stderr,'(A)') solver_name
294  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompK: '
295  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
296  WRITE(stderr,'(A)') solver_name
297 #ifdef MPI
298  CALL mpi_abort( error )
299 #endif
300  stop
301  ENDIF
302 
303  dh = 1._rfreal/REAL( kend-kbeg-2*ndum )
304  r2dh = 0.5_rfreal/dh
305 
306  DO k=kbeg+1,kend-1
307  DO j=jbeg,jend
308  DO i=ibeg,iend
309  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
310  ijknp = indijk(i ,j ,k+1 ,inoff,ijnoff)
311  ijknm = indijk(i ,j ,k-1 ,inoff,ijnoff)
312  dvar(idb:ide,ijkn) = (var(idb:ide,ijknp) - var(idb:ide,ijknm))*r2dh
313  ENDDO
314  ENDDO
315  ENDDO
316 
317  DO i=ibeg,iend
318  DO j=jbeg,jend
319  DO k=kbeg,kbeg
320  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
321  ijkn1 = indijk(i ,j ,k+1 ,inoff,ijnoff)
322  ijkn2 = indijk(i ,j ,k+2 ,inoff,ijnoff)
323  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
324  ENDDO
325  DO k=kend,kend
326  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
327  ijkn1 = indijk(i ,j ,k-1 ,inoff,ijnoff)
328  ijkn2 = indijk(i ,j ,k-2 ,inoff,ijnoff)
329  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
330  ENDDO
331  ENDDO
332  ENDDO
333 
334 ! finalize --------------------------------------------------------------------
335 
336 END SUBROUTINE rflo_findiffcompk
337 
338 
339 !******************************************************************************
340 !
341 ! Purpose: perform 2nd derivative finite difference in I-direction in
342 ! computational space
343 !
344 ! Description: based on 2nd order central differencing
345 !
346 ! Input: ibeg, iend, jbeg, jend, kbeg, kend = region range indices
347 ! iNOff = i-stride
348 ! ijNOff = ij-stride
349 ! idb, ide = begin and end indexing of first dimension of var(:,:)
350 ! var = real variable to be extrapolated
351 !
352 ! Output: dvar = resulting derivative
353 !
354 ! Notes: none.
355 !
356 !******************************************************************************
357 
358 SUBROUTINE rflo_findiffcompii( ibeg,iend,jbeg,jend,kbeg,kend,ndum, &
359  inoff,ijnoff,idb,ide,var,dvar )
360 
361  IMPLICIT NONE
362 
363 #include "Indexing.h"
364 
365 ! ... parameters
366  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ndum, idb, ide, inoff, ijnoff
367  REAL(RFREAL), POINTER :: var(:,:), dvar(:,:)
368 
369 ! ... loop variables
370  INTEGER :: i, j, k
371 
372 ! ... local variables
373  INTEGER :: nelm, ndim, ijkn, ijknp, ijknm, ijkn1, ijkn2, error
374  REAL(RFREAL) :: dh, rdh2
375 
376 !******************************************************************************
377 
378  nelm = ide-idb+1
379  ndim = (iend-ibeg+1)*(jend-jbeg+1)*(kend-kbeg+1)
380 
381  IF ((SIZE( var,1 ) < nelm) .OR. (SIZE( var,2 ) /= ndim)) THEN
382  WRITE(stderr,'(A)') solver_name
383  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompII: '
384  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
385  WRITE(stderr,'(A)') solver_name
386 #ifdef MPI
387  CALL mpi_abort( error )
388 #endif
389  stop
390  ENDIF
391 
392  dh = 1._rfreal/REAL( iend-ibeg-2*ndum )
393  rdh2 = 1._rfreal/(dh*dh)
394 
395  DO k=kbeg,kend
396  DO j=jbeg,jend
397  DO i=ibeg+1,iend-1
398  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
399  ijknp = indijk(i+1 ,j ,k ,inoff,ijnoff)
400  ijknm = indijk(i-1 ,j ,k ,inoff,ijnoff)
401  dvar(idb:ide,ijkn) = (var(idb:ide,ijknp) -2._rfreal*var(idb:ide,ijkn)+ &
402  var(idb:ide,ijknm))*rdh2
403  ENDDO
404  DO i=ibeg,ibeg
405  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
406  ijkn1 = indijk(i+1 ,j ,k ,inoff,ijnoff)
407  ijkn2 = indijk(i+2 ,j ,k ,inoff,ijnoff)
408  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
409  ENDDO
410  DO i=iend,iend
411  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
412  ijkn1 = indijk(i-1 ,j ,k ,inoff,ijnoff)
413  ijkn2 = indijk(i-2 ,j ,k ,inoff,ijnoff)
414  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
415  ENDDO
416  ENDDO
417  ENDDO
418 
419 ! finalize --------------------------------------------------------------------
420 
421 END SUBROUTINE rflo_findiffcompii
422 
423 
424 !******************************************************************************
425 !
426 ! Purpose: perform 2nd derivative finite difference in J-direction in
427 ! computational space
428 !
429 ! Description: based on 2nd order central differencing
430 !
431 ! Input: ibeg, iend, jbeg, jend, kbeg, kend = region range indices
432 ! iNOff = i-stride
433 ! ijNOff = ij-stride
434 ! idb, ide = begin and end indexing of first dimension of var(:,:)
435 ! var = real variable to be extrapolated
436 !
437 ! Output: dvar = resulting derivative
438 !
439 ! Notes: none.
440 !
441 !******************************************************************************
442 
443 SUBROUTINE rflo_findiffcompjj( ibeg,iend,jbeg,jend,kbeg,kend,ndum, &
444  inoff,ijnoff,idb,ide,var,dvar )
445 
446  IMPLICIT NONE
447 
448 #include "Indexing.h"
449 
450 ! ... parameters
451  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ndum, idb, ide, inoff, ijnoff
452  REAL(RFREAL), POINTER :: var(:,:), dvar(:,:)
453 
454 ! ... loop variables
455  INTEGER :: i, j, k
456 
457 ! ... local variables
458  INTEGER :: nelm, ndim, ijkn, ijknp, ijknm, ijkn1, ijkn2, error
459  REAL(RFREAL) :: dh, rdh2
460 
461 !******************************************************************************
462 
463  nelm = ide-idb+1
464  ndim = (iend-ibeg+1)*(jend-jbeg+1)*(kend-kbeg+1)
465 
466  IF ((SIZE( var,1 ) < nelm) .OR. (SIZE( var,2 ) /= ndim)) THEN
467  WRITE(stderr,'(A)') solver_name
468  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompJJ: '
469  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
470  WRITE(stderr,'(A)') solver_name
471 #ifdef MPI
472  CALL mpi_abort( error )
473 #endif
474  stop
475  ENDIF
476 
477  dh = 1._rfreal/REAL( jend-jbeg-2*ndum )
478  rdh2 = 1._rfreal/(dh*dh)
479 
480  DO k=kbeg,kend
481  DO j=jbeg+1,jend-1
482  DO i=ibeg,iend
483  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
484  ijknp = indijk(i ,j+1 ,k ,inoff,ijnoff)
485  ijknm = indijk(i ,j-1 ,k ,inoff,ijnoff)
486  dvar(idb:ide,ijkn) = (var(idb:ide,ijknp)-2._rfreal*var(idb:ide,ijkn)+ &
487  var(idb:ide,ijknm))*rdh2
488  ENDDO
489  ENDDO
490  ENDDO
491 
492  DO i=ibeg,iend
493  DO k=kbeg,kend
494  DO j=jbeg,jbeg
495  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
496  ijkn1 = indijk(i ,j+1 ,k ,inoff,ijnoff)
497  ijkn2 = indijk(i ,j+2 ,k ,inoff,ijnoff)
498  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
499  ENDDO
500  DO j=jend,jend
501  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
502  ijkn1 = indijk(i ,j-1 ,k ,inoff,ijnoff)
503  ijkn2 = indijk(i ,j-2 ,k ,inoff,ijnoff)
504  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
505  ENDDO
506  ENDDO
507  ENDDO
508 
509 ! finalize --------------------------------------------------------------------
510 
511 END SUBROUTINE rflo_findiffcompjj
512 
513 
514 !******************************************************************************
515 !
516 ! Purpose: perform 2nd derivative finite difference in K-direction in
517 ! computational space
518 !
519 ! Description: based on 2nd order central differencing
520 !
521 ! Input: ibeg, iend, jbeg, jend, kbeg, kend = region range indices
522 ! iNOff = i-stride
523 ! ijNOff = ij-stride
524 ! idb, ide = begin and end indexing of first dimension of var(:,:)
525 ! var = real variable to be extrapolated
526 !
527 ! Output: dvar = resulting derivative
528 !
529 ! Notes: none.
530 !
531 !******************************************************************************
532 
533 SUBROUTINE rflo_findiffcompkk( ibeg,iend,jbeg,jend,kbeg,kend,ndum, &
534  inoff,ijnoff,idb,ide,var,dvar )
535 
536  IMPLICIT NONE
537 
538 #include "Indexing.h"
539 
540 ! ... parameters
541  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, ndum, idb, ide, inoff, ijnoff
542  REAL(RFREAL), POINTER :: var(:,:), dvar(:,:)
543 
544 ! ... loop variables
545  INTEGER :: i, j, k
546 
547 ! ... local variables
548  INTEGER :: nelm, ndim, ijkn, ijknp, ijknm, ijkn1, ijkn2, error
549  REAL(RFREAL) :: dh, rdh2
550 
551 !******************************************************************************
552 
553  nelm = ide-idb+1
554  ndim = (iend-ibeg+1)*(jend-jbeg+1)*(kend-kbeg+1)
555 
556  IF ((SIZE( var,1 ) < nelm) .OR. (SIZE( var,2 ) /= ndim)) THEN
557  WRITE(stderr,'(A)') solver_name
558  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompKK: '
559  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
560  WRITE(stderr,'(A)') solver_name
561 #ifdef MPI
562  CALL mpi_abort( error )
563 #endif
564  stop
565  ENDIF
566 
567  dh = 1._rfreal/REAL( kend-kbeg-2*ndum )
568  rdh2 = 1._rfreal/(dh*dh)
569 
570  DO k=kbeg+1,kend-1
571  DO j=jbeg,jend
572  DO i=ibeg,iend
573  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
574  ijknp = indijk(i ,j ,k+1 ,inoff,ijnoff)
575  ijknm = indijk(i ,j ,k-1 ,inoff,ijnoff)
576  dvar(idb:ide,ijkn) = (var(idb:ide,ijknp)-2._rfreal*var(idb:ide,ijkn)+ &
577  var(idb:ide,ijknm))*rdh2
578  ENDDO
579  ENDDO
580  ENDDO
581 
582  DO i=ibeg,iend
583  DO j=jbeg,jend
584  DO k=kbeg,kbeg
585  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
586  ijkn1 = indijk(i ,j ,k+1 ,inoff,ijnoff)
587  ijkn2 = indijk(i ,j ,k+2 ,inoff,ijnoff)
588  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
589  ENDDO
590  DO k=kend,kend
591  ijkn = indijk(i ,j ,k ,inoff,ijnoff)
592  ijkn1 = indijk(i ,j ,k-1 ,inoff,ijnoff)
593  ijkn2 = indijk(i ,j ,k-2 ,inoff,ijnoff)
594  dvar(idb:ide,ijkn) = 2*dvar(idb:ide,ijkn1) - dvar(idb:ide,ijkn2)
595  ENDDO
596  ENDDO
597  ENDDO
598 
599 ! finalize --------------------------------------------------------------------
600 
601 END SUBROUTINE rflo_findiffcompkk
602 
603 
604 !******************************************************************************
605 !
606 ! Purpose: perform 1st derivative finite difference in I-direction in
607 ! 2D computational space (patch surface)
608 !
609 ! Description: based on 2nd order central differencing
610 !
611 ! Input: ni, nj = patch dimensions
612 ! idb, ide = begin and end indexing of first dimension of var(:,:)
613 ! var = real variable to be extrapolated
614 !
615 ! Output: dvar = resulting derivative
616 !
617 ! Notes: none.
618 !
619 !******************************************************************************
620 
621 SUBROUTINE rflo_findiffcompis( ni,nj,idb,ide,var,dvar )
622 
623  IMPLICIT NONE
624 
625 #include "Indexing.h"
626 
627 ! ... parameters
628  INTEGER :: ni, nj, idb, ide
629  REAL(RFREAL), POINTER :: var(:,:,:), dvar(:,:,:)
630 
631 ! ... loop variables
632  INTEGER :: i, j
633 
634 ! ... local variables
635  INTEGER :: nelm, ndim1, ndim2, error
636  REAL(RFREAL) :: dh, r2dh
637 
638 !******************************************************************************
639 
640  nelm = ide-idb+1
641  ndim1 = ni
642  ndim2 = nj
643 
644  IF ((SIZE( var,1 ) < nelm ) .OR. &
645  (SIZE( var,2 ) /= ndim1) .OR. &
646  (SIZE( var,3 ) /= ndim2)) THEN
647  WRITE(stderr,'(A)') solver_name
648  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompIs: '
649  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
650  WRITE(stderr,'(A)') solver_name
651 #ifdef MPI
652  CALL mpi_abort( error )
653 #endif
654  stop
655  ENDIF
656 
657  dh = 1._rfreal/REAL( ni-1 )
658  r2dh = 0.5_rfreal/dh
659 
660  DO j=1,nj
661  DO i=2,ni-1
662  dvar(idb:ide,i,j) = (var(idb:ide,i+1,j) - var(idb:ide,i-1,j))*r2dh
663  ENDDO
664  DO i=1,1
665  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i+1,j) - dvar(idb:ide,i+2,j)
666  ENDDO
667  DO i=ni,ni
668  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i-1,j) - dvar(idb:ide,i-2,j)
669  ENDDO
670  ENDDO
671 
672 ! finalize --------------------------------------------------------------------
673 
674 END SUBROUTINE rflo_findiffcompis
675 
676 
677 !******************************************************************************
678 !
679 ! Purpose: perform 1st derivative finite difference in J-direction in
680 ! 2D computational space (patch surface)
681 !
682 ! Description: based on 2nd order central differencing
683 !
684 ! Input: ni, nj = patch dimensions
685 ! idb, ide = begin and end indexing of first dimension of var(:,:)
686 ! var = real variable to be extrapolated
687 !
688 ! Output: dvar = resulting derivative
689 !
690 ! Notes: none.
691 !
692 !******************************************************************************
693 
694 SUBROUTINE rflo_findiffcompjs( ni,nj,idb,ide,var,dvar )
695 
696  IMPLICIT NONE
697 
698 #include "Indexing.h"
699 
700 ! ... parameters
701  INTEGER :: ni, nj, idb, ide
702  REAL(RFREAL), POINTER :: var(:,:,:), dvar(:,:,:)
703 
704 ! ... loop variables
705  INTEGER :: i, j
706 
707 ! ... local variables
708  INTEGER :: nelm, ndim1, ndim2, error
709  REAL(RFREAL) :: dh, r2dh
710 
711 !******************************************************************************
712 
713  nelm = ide-idb+1
714  ndim1 = ni
715  ndim2 = nj
716 
717  IF ((SIZE( var,1 ) < nelm ) .OR. &
718  (SIZE( var,2 ) /= ndim1) .OR. &
719  (SIZE( var,3 ) /= ndim2)) THEN
720  WRITE(stderr,'(A)') solver_name
721  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompJs: '
722  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
723  WRITE(stderr,'(A)') solver_name
724 #ifdef MPI
725  CALL mpi_abort( error )
726 #endif
727  stop
728  ENDIF
729 
730  dh = 1._rfreal/REAL( nj-1 )
731  r2dh = 0.5_rfreal/dh
732 
733  DO j=2,nj-1
734  DO i=1,ni
735  dvar(idb:ide,i,j) = (var(idb:ide,i,j+1) - var(idb:ide,i,j-1))*r2dh
736  ENDDO
737  ENDDO
738  DO j=1,1
739  DO i=1,ni
740  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i,j+1) - dvar(idb:ide,i,j+2)
741  ENDDO
742  ENDDO
743  DO j=nj,nj
744  DO i=1,ni
745  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i,j-1) - dvar(idb:ide,i,j-2)
746  ENDDO
747  ENDDO
748 
749 ! finalize --------------------------------------------------------------------
750 
751 END SUBROUTINE rflo_findiffcompjs
752 
753 
754 !******************************************************************************
755 !
756 ! Purpose: perform 2nd derivative finite difference in I-direction in
757 ! 2D computational space (patch surface)
758 !
759 ! Description: based on 2nd order central differencing
760 !
761 ! Input: ni, nj = patch dimensions
762 ! idb, ide = begin and end indexing of first dimension of var(:,:)
763 ! var = real variable to be extrapolated
764 !
765 ! Output: dvar = resulting derivative
766 !
767 ! Notes: none.
768 !
769 !******************************************************************************
770 
771 SUBROUTINE rflo_findiffcompiis( ni,nj,idb,ide,var,dvar )
772 
773  IMPLICIT NONE
774 
775 #include "Indexing.h"
776 
777 ! ... parameters
778  INTEGER :: ni, nj, idb, ide
779  REAL(RFREAL), POINTER :: var(:,:,:), dvar(:,:,:)
780 
781 ! ... loop variables
782  INTEGER :: i, j
783 
784 ! ... local variables
785  INTEGER :: nelm, ndim1, ndim2, error
786  REAL(RFREAL) :: dh, rdh2
787 
788 !******************************************************************************
789 
790  nelm = ide-idb+1
791  ndim1 = ni
792  ndim2 = nj
793 
794  IF ((SIZE( var,1 ) < nelm ) .OR. &
795  (SIZE( var,2 ) /= ndim1) .OR. &
796  (SIZE( var,3 ) /= ndim2)) THEN
797  WRITE(stderr,'(A)') solver_name
798  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompIIs: '
799  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
800  WRITE(stderr,'(A)') solver_name
801 #ifdef MPI
802  CALL mpi_abort( error )
803 #endif
804  stop
805  ENDIF
806 
807  dh = 1._rfreal/REAL( ni-1 )
808  rdh2 = 1._rfreal/(dh*dh)
809 
810  DO j=1,nj
811  DO i=2,ni-1
812  dvar(idb:ide,i,j) = (var(idb:ide,i+1,j) - 2._rfreal*var(idb:ide,i,j) + &
813  var(idb:ide,i-1,j))*rdh2
814  ENDDO
815  DO i=1,1
816  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i+1,j) - dvar(idb:ide,i+2,j)
817  ENDDO
818  DO i=ni,ni
819  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i-1,j) - dvar(idb:ide,i-2,j)
820  ENDDO
821  ENDDO
822 
823 ! finalize --------------------------------------------------------------------
824 
825 END SUBROUTINE rflo_findiffcompiis
826 
827 
828 !******************************************************************************
829 !
830 ! Purpose: perform 2nd derivative finite difference in J-direction in
831 ! 2D computational space (patch surface)
832 !
833 ! Description: based on 2nd order central differencing
834 !
835 ! Input: ni, nj = patch dimensions
836 ! idb, ide = begin and end indexing of first dimension of var(:,:)
837 ! var = real variable to be extrapolated
838 !
839 ! Output: dvar = resulting derivative
840 !
841 ! Notes: none.
842 !
843 !******************************************************************************
844 
845 SUBROUTINE rflo_findiffcompjjs( ni,nj,idb,ide,var,dvar )
846 
847  IMPLICIT NONE
848 
849 #include "Indexing.h"
850 
851 ! ... parameters
852  INTEGER :: ni, nj, idb, ide
853  REAL(RFREAL), POINTER :: var(:,:,:), dvar(:,:,:)
854 
855 ! ... loop variables
856  INTEGER :: i, j
857 
858 ! ... local variables
859  INTEGER :: nelm, ndim1, ndim2, error
860  REAL(RFREAL) :: dh, rdh2
861 
862 !******************************************************************************
863 
864  nelm = ide-idb+1
865  ndim1 = ni
866  ndim2 = nj
867 
868  IF ((SIZE( var,1 ) < nelm ) .OR. &
869  (SIZE( var,2 ) /= ndim1) .OR. &
870  (SIZE( var,3 ) /= ndim2)) THEN
871  WRITE(stderr,'(A)') solver_name
872  WRITE(stderr,'(A,1X,A)') solver_name,'ERROR in RFLO_FinDiffCompJJs: '
873  WRITE(stderr,'(A,1X,A)') solver_name,'inconsistent 1st or 2nd dimension'
874  WRITE(stderr,'(A)') solver_name
875 #ifdef MPI
876  CALL mpi_abort( error )
877 #endif
878  stop
879  ENDIF
880 
881  dh = 1._rfreal/REAL( nj-1 )
882  rdh2 = 1._rfreal/(dh*dh)
883 
884  DO j=2,nj-1
885  DO i=1,ni
886  dvar(idb:ide,i,j) = (var(idb:ide,i,j+1) - 2._rfreal*var(idb:ide,i,j) + &
887  var(idb:ide,i,j-1))*rdh2
888  ENDDO
889  ENDDO
890  DO j=1,1
891  DO i=1,ni
892  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i,j+1) - dvar(idb:ide,i,j+2)
893  ENDDO
894  ENDDO
895  DO j=nj,nj
896  DO i=1,ni
897  dvar(idb:ide,i,j) = 2*dvar(idb:ide,i,j-1) - dvar(idb:ide,i,j-2)
898  ENDDO
899  ENDDO
900 
901 ! finalize --------------------------------------------------------------------
902 
903 END SUBROUTINE rflo_findiffcompjjs
904 
905 
906 ! ******************************************************************************
907 ! End
908 ! ******************************************************************************
909 
910 END MODULE rflo_modfinitedifference
911 
912 ! ******************************************************************************
913 !
914 ! RCS Revision history:
915 !
916 ! $Log: RFLO_ModFiniteDifference.F90,v $
917 ! Revision 1.4 2008/12/06 08:44:16 mtcampbe
918 ! Updated license.
919 !
920 ! Revision 1.3 2008/11/19 22:17:27 mtcampbe
921 ! Added Illinois Open Source License/Copyright
922 !
923 ! Revision 1.2 2005/12/07 08:45:51 wasistho
924 ! added stuff for surface mesh motion EPDE
925 !
926 ! Revision 1.1 2005/12/03 09:39:47 wasistho
927 ! initial import
928 !
929 !
930 !
931 ! ******************************************************************************
932 
933 
934 
935 
936 
937 
**********************************************************************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
subroutine, public rflo_findiffcompis(ni, nj, idb, ide, var, dvar)
j indices k indices k
Definition: Indexing.h:6
subroutine, public rflo_findiffcompi(ibeg, iend, jbeg, jend, kbeg, kend, ndum, iNOff, ijNOff, idb, ide, var, dvar)
subroutine, public rflo_findiffcompjj(ibeg, iend, jbeg, jend, kbeg, kend, ndum, iNOff, ijNOff, idb, ide, var, dvar)
subroutine, public rflo_findiffcompjs(ni, nj, idb, ide, var, dvar)
subroutine, public rflo_findiffcompiis(ni, nj, idb, ide, var, dvar)
**********************************************************************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
subroutine, public rflo_findiffcompj(ibeg, iend, jbeg, jend, kbeg, kend, ndum, iNOff, ijNOff, idb, ide, var, dvar)
blockLoc i
Definition: read.cpp:79
subroutine, public rflo_findiffcompkk(ibeg, iend, jbeg, jend, kbeg, kend, ndum, iNOff, ijNOff, idb, ide, var, dvar)
subroutine, public rflo_findiffcompjjs(ni, nj, idb, ide, var, dvar)
subroutine, public rflo_findiffcompk(ibeg, iend, jbeg, jend, kbeg, kend, ndum, iNOff, ijNOff, idb, ide, var, dvar)
j indices j
Definition: Indexing.h:6
**********************************************************************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
**********************************************************************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
void int int REAL REAL REAL *z blockDim dim * ni
Definition: read.cpp:77
void int * nj
Definition: read.cpp:74
subroutine, public rflo_findiffcompii(ibeg, iend, jbeg, jend, kbeg, kend, ndum, iNOff, ijNOff, idb, ide, var, dvar)
**********************************************************************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