[TEST]UPSTREAM: Pick some source changes from 48080d0a97
* Sync new folder structure
This commit is contained in:
434
AMSS_NCKU_source/KO_dissipation/kodiss.f90
Normal file
434
AMSS_NCKU_source/KO_dissipation/kodiss.f90
Normal file
@@ -0,0 +1,434 @@
|
||||
|
||||
|
||||
#include "macrodef.fh"
|
||||
|
||||
! we need only distinguish different finite difference order
|
||||
! Vertex or Cell is distinguished in routine symmetry_bd which locates in
|
||||
! file "fmisc.f90"
|
||||
|
||||
#if (ghost_width == 2)
|
||||
! second order code
|
||||
|
||||
!------------------------------------------------------------------------------------------------------------------------------
|
||||
!usual type Kreiss-Oliger type numerical dissipation
|
||||
!We support cell center only
|
||||
! (D_+D_-)^2 =
|
||||
! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2)
|
||||
! ------------------------------------------------------
|
||||
! dx^4
|
||||
!------------------------------------------------------------------------------------------------------------------------------
|
||||
! do not add dissipation near boundary
|
||||
subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in) :: Symmetry
|
||||
integer,dimension(3),intent(in)::ex
|
||||
real*8, dimension(1:3), intent(in) :: SoA
|
||||
double precision,intent(in),dimension(ex(1))::X
|
||||
double precision,intent(in),dimension(ex(2))::Y
|
||||
double precision,intent(in),dimension(ex(3))::Z
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f
|
||||
double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs
|
||||
real*8,intent(in) :: eps
|
||||
|
||||
!~~~~~~ other variables
|
||||
|
||||
real*8 :: dX,dY,dZ
|
||||
real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh
|
||||
integer :: imin,jmin,kmin,imax,jmax,kmax
|
||||
integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2
|
||||
real*8,parameter :: cof = 1.6d1 ! 2^4
|
||||
real*8, parameter :: F4=4.d0,F6=6.d0
|
||||
integer::i,j,k
|
||||
|
||||
dX = X(2)-X(1)
|
||||
dY = Y(2)-Y(1)
|
||||
dZ = Z(2)-Z(1)
|
||||
|
||||
imax = ex(1)
|
||||
jmax = ex(2)
|
||||
kmax = ex(3)
|
||||
|
||||
imin = 1
|
||||
jmin = 1
|
||||
kmin = 1
|
||||
|
||||
if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1
|
||||
if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1
|
||||
if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1
|
||||
|
||||
call symmetry_bd(2,ex,f,fh,SoA)
|
||||
|
||||
! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2)
|
||||
! ------------------------------------------------------
|
||||
! dx^4
|
||||
|
||||
! note the sign (-1)^r-1, now r=2
|
||||
!DIR$ SIMD VECTORLENGTHFOR(KNOWN_INTEGER=8)
|
||||
!DIR$ UNROLL PARTIAL(4)
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
|
||||
if(i-2 >= imin .and. i+2 <= imax .and. &
|
||||
j-2 >= jmin .and. j+2 <= jmax .and. &
|
||||
k-2 >= kmin .and. k+2 <= kmax) then
|
||||
! x direction
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( &
|
||||
(fh(i-2,j,k)+fh(i+2,j,k)) &
|
||||
- F4 * (fh(i-1,j,k)+fh(i+1,j,k)) &
|
||||
+ F6 * fh(i,j,k) )
|
||||
! y direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( &
|
||||
(fh(i,j-2,k)+fh(i,j+2,k)) &
|
||||
- F4 * (fh(i,j-1,k)+fh(i,j+1,k)) &
|
||||
+ F6 * fh(i,j,k) )
|
||||
! z direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( &
|
||||
(fh(i,j,k-2)+fh(i,j,k+2)) &
|
||||
- F4 * (fh(i,j,k-1)+fh(i,j,k+1)) &
|
||||
+ F6 * fh(i,j,k) )
|
||||
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine kodis
|
||||
|
||||
#elif (ghost_width == 3)
|
||||
! fourth order code
|
||||
|
||||
!---------------------------------------------------------------------------------------------
|
||||
!usual type Kreiss-Oliger type numerical dissipation
|
||||
!We support cell center only
|
||||
! Note the notation D_+ and D_- [P240 of B. Gustafsson, H.-O. Kreiss, and J. Oliger, Time
|
||||
! Dependent Problems and Difference Methods (Wiley, New York, 1995).]
|
||||
! D_+ = (f(i+1) - f(i))/h
|
||||
! D_- = (f(i) - f(i-1))/h
|
||||
! then we have D_+D_- = D_-D_+
|
||||
! D_+^3D_-^3 = (D_+D_-)^3 =
|
||||
! f(i-3) - 6 f(i-2) + 15 f(i-1) - 20 f(i) + 15 f(i+1) - 6 f(i+2) + f(i+3)
|
||||
! -----------------------------------------------------------------------------
|
||||
! dx^6
|
||||
! this is for 4th order accurate finite difference scheme
|
||||
!---------------------------------------------------------------------------------------------
|
||||
subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in) :: Symmetry
|
||||
integer,dimension(3),intent(in)::ex
|
||||
real*8, dimension(1:3), intent(in) :: SoA
|
||||
double precision,intent(in),dimension(ex(1))::X
|
||||
double precision,intent(in),dimension(ex(2))::Y
|
||||
double precision,intent(in),dimension(ex(3))::Z
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f
|
||||
double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs
|
||||
real*8,intent(in) :: eps
|
||||
! local variables
|
||||
real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh
|
||||
integer :: imin,jmin,kmin,imax,jmax,kmax
|
||||
integer :: i,j,k
|
||||
real*8 :: dX,dY,dZ
|
||||
real*8, parameter :: ONE=1.d0,SIX=6.d0,FIT=1.5d1,TWT=2.d1
|
||||
real*8,parameter::cof=6.4d1 ! 2^6
|
||||
integer, parameter :: NO_SYMM=0, OCTANT=2
|
||||
|
||||
!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3)
|
||||
|
||||
dX = X(2)-X(1)
|
||||
dY = Y(2)-Y(1)
|
||||
dZ = Z(2)-Z(1)
|
||||
|
||||
imax = ex(1)
|
||||
jmax = ex(2)
|
||||
kmax = ex(3)
|
||||
|
||||
imin = 1
|
||||
jmin = 1
|
||||
kmin = 1
|
||||
|
||||
if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2
|
||||
if(Symmetry == OCTANT .and. dabs(X(1)) < dX) imin = -2
|
||||
if(Symmetry == OCTANT .and. dabs(Y(1)) < dY) jmin = -2
|
||||
|
||||
call symmetry_bd(3,ex,f,fh,SoA)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
|
||||
if(i-3 >= imin .and. i+3 <= imax .and. &
|
||||
j-3 >= jmin .and. j+3 <= jmax .and. &
|
||||
k-3 >= kmin .and. k+3 <= kmax) then
|
||||
#if 0
|
||||
! x direction
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( &
|
||||
(fh(i-3,j,k)+fh(i+3,j,k)) - &
|
||||
SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + &
|
||||
FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - &
|
||||
TWT* fh(i,j,k) )
|
||||
! y direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( &
|
||||
(fh(i,j-3,k)+fh(i,j+3,k)) - &
|
||||
SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + &
|
||||
FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - &
|
||||
TWT* fh(i,j,k) )
|
||||
! z direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( &
|
||||
(fh(i,j,k-3)+fh(i,j,k+3)) - &
|
||||
SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + &
|
||||
FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - &
|
||||
TWT* fh(i,j,k) )
|
||||
#else
|
||||
! calculation order if important ?
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/cof *( ( &
|
||||
(fh(i-3,j,k)+fh(i+3,j,k)) - &
|
||||
SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + &
|
||||
FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - &
|
||||
TWT* fh(i,j,k) )/dX + &
|
||||
( &
|
||||
(fh(i,j-3,k)+fh(i,j+3,k)) - &
|
||||
SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + &
|
||||
FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - &
|
||||
TWT* fh(i,j,k) )/dY + &
|
||||
( &
|
||||
(fh(i,j,k-3)+fh(i,j,k+3)) - &
|
||||
SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + &
|
||||
FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - &
|
||||
TWT* fh(i,j,k) )/dZ )
|
||||
#endif
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine kodis
|
||||
|
||||
#elif (ghost_width == 4)
|
||||
! sixth order code
|
||||
!------------------------------------------------------------------------------------------------------------------------------
|
||||
!usual type Kreiss-Oliger type numerical dissipation
|
||||
!We support cell center only
|
||||
! (D_+D_-)^4 =
|
||||
! f(i-4) - 8 f(i-3) + 28 f(i-2) - 56 f(i-1) + 70 f(i) - 56 f(i+1) + 28 f(i+2) - 8 f(i+3) + f(i+4)
|
||||
! ----------------------------------------------------------------------------------------------------------
|
||||
! dx^8
|
||||
!------------------------------------------------------------------------------------------------------------------------------
|
||||
! do not add dissipation near boundary
|
||||
subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in) :: Symmetry
|
||||
integer,dimension(3),intent(in)::ex
|
||||
real*8, dimension(1:3), intent(in) :: SoA
|
||||
double precision,intent(in),dimension(ex(1))::X
|
||||
double precision,intent(in),dimension(ex(2))::Y
|
||||
double precision,intent(in),dimension(ex(3))::Z
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f
|
||||
double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs
|
||||
real*8,intent(in) :: eps
|
||||
|
||||
!~~~~~~ other variables
|
||||
|
||||
real*8 :: dX,dY,dZ
|
||||
real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh
|
||||
integer :: imin,jmin,kmin,imax,jmax,kmax
|
||||
integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2
|
||||
real*8,parameter :: cof = 2.56d2 ! 2^8
|
||||
real*8, parameter :: F8=8.d0,F28=2.8d1,F56=5.6d1,F70=7.d1
|
||||
integer::i,j,k
|
||||
|
||||
dX = X(2)-X(1)
|
||||
dY = Y(2)-Y(1)
|
||||
dZ = Z(2)-Z(1)
|
||||
|
||||
imax = ex(1)
|
||||
jmax = ex(2)
|
||||
kmax = ex(3)
|
||||
|
||||
imin = 1
|
||||
jmin = 1
|
||||
kmin = 1
|
||||
|
||||
if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3
|
||||
if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3
|
||||
if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3
|
||||
|
||||
call symmetry_bd(4,ex,f,fh,SoA)
|
||||
|
||||
! f(i-4) - 8 f(i-3) + 28 f(i-2) - 56 f(i-1) + 70 f(i) - 56 f(i+1) + 28 f(i+2) - 8 f(i+3) + f(i+4)
|
||||
! ----------------------------------------------------------------------------------------------------------
|
||||
! dx^8
|
||||
|
||||
! note the sign (-1)^r-1, now r=4
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
|
||||
if(i>imin+3 .and. i < imax-3 .and. &
|
||||
j>jmin+3 .and. j < jmax-3 .and. &
|
||||
k>kmin+3 .and. k < kmax-3) then
|
||||
! x direction
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( &
|
||||
(fh(i-4,j,k)+fh(i+4,j,k)) &
|
||||
- F8 * (fh(i-3,j,k)+fh(i+3,j,k)) &
|
||||
+F28 * (fh(i-2,j,k)+fh(i+2,j,k)) &
|
||||
-F56 * (fh(i-1,j,k)+fh(i+1,j,k)) &
|
||||
+F70 * fh(i,j,k) )
|
||||
! y direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( &
|
||||
(fh(i,j-4,k)+fh(i,j+4,k)) &
|
||||
- F8 * (fh(i,j-3,k)+fh(i,j+3,k)) &
|
||||
+F28 * (fh(i,j-2,k)+fh(i,j+2,k)) &
|
||||
-F56 * (fh(i,j-1,k)+fh(i,j+1,k)) &
|
||||
+F70 * fh(i,j,k) )
|
||||
! z direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( &
|
||||
(fh(i,j,k-4)+fh(i,j,k+4)) &
|
||||
- F8 * (fh(i,j,k-3)+fh(i,j,k+3)) &
|
||||
+F28 * (fh(i,j,k-2)+fh(i,j,k+2)) &
|
||||
-F56 * (fh(i,j,k-1)+fh(i,j,k+1)) &
|
||||
+F70 * fh(i,j,k) )
|
||||
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine kodis
|
||||
|
||||
#elif (ghost_width == 5)
|
||||
! eighth order code
|
||||
!------------------------------------------------------------------------------------------------------------------------------
|
||||
!usual type Kreiss-Oliger type numerical dissipation
|
||||
!We support cell center only
|
||||
! Note the notation D_+ and D_- [P240 of B. Gustafsson, H.-O. Kreiss, and J. Oliger, Time
|
||||
! Dependent Problems and Difference Methods (Wiley, New York, 1995).]
|
||||
! D_+ = (f(i+1) - f(i))/h
|
||||
! D_- = (f(i) - f(i-1))/h
|
||||
! then we have D_+D_- = D_-D_+ = (f(i+1) - 2f(i) + f(i-1))/h^2
|
||||
! for nth order accurate finite difference code, we need r =n/2+1
|
||||
! D_+^rD_-^r = (D_+D_-)^r
|
||||
! following the tradiation of PRD 77, 024027 (BB's calibration paper, Eq.(64),
|
||||
! correct some typo according to above book) :
|
||||
! + eps*(-1)^(r-1)*h^(2r-1)/2^(2r)*(D_+D_-)^r
|
||||
!
|
||||
!
|
||||
! this is for 8th order accurate finite difference scheme
|
||||
! (D_+D_-)^5 =
|
||||
! f(i-5) - 10 f(i-4) + 45 f(i-3) - 120 f(i-2) + 210 f(i-1) - 252 f(i) + 210 f(i+1) - 120 f(i+2) + 45 f(i+3) - 10 f(i+4) + f(i+5)
|
||||
! -------------------------------------------------------------------------------------------------------------------------------
|
||||
! dx^10
|
||||
!---------------------------------------------------------------------------------------------------------------------------------
|
||||
! do not add dissipation near boundary
|
||||
subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in) :: Symmetry
|
||||
integer,dimension(3),intent(in)::ex
|
||||
real*8, dimension(1:3), intent(in) :: SoA
|
||||
double precision,intent(in),dimension(ex(1))::X
|
||||
double precision,intent(in),dimension(ex(2))::Y
|
||||
double precision,intent(in),dimension(ex(3))::Z
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f
|
||||
double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs
|
||||
real*8,intent(in) :: eps
|
||||
|
||||
!~~~~~~ other variables
|
||||
|
||||
real*8 :: dX,dY,dZ
|
||||
real*8,dimension(-4:ex(1),-4:ex(2),-4:ex(3)) :: fh
|
||||
integer :: imin,jmin,kmin,imax,jmax,kmax
|
||||
integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2
|
||||
real*8,parameter :: cof = 1.024d3 ! 2^2r = 2^10
|
||||
real*8, parameter :: F10=1.d1,F45=4.5d1,F120=1.2d2,F210=2.1d2,F252=2.52d2
|
||||
integer::i,j,k
|
||||
|
||||
dX = X(2)-X(1)
|
||||
dY = Y(2)-Y(1)
|
||||
dZ = Z(2)-Z(1)
|
||||
|
||||
imax = ex(1)
|
||||
jmax = ex(2)
|
||||
kmax = ex(3)
|
||||
|
||||
imin = 1
|
||||
jmin = 1
|
||||
kmin = 1
|
||||
|
||||
if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -4
|
||||
if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -4
|
||||
if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -4
|
||||
|
||||
call symmetry_bd(5,ex,f,fh,SoA)
|
||||
|
||||
! f(i-5) - 10 f(i-4) + 45 f(i-3) - 120 f(i-2) + 210 f(i-1) - 252 f(i) + 210 f(i+1) - 120 f(i+2) + 45 f(i+3) - 10 f(i+4) + f(i+5)
|
||||
! -------------------------------------------------------------------------------------------------------------------------------
|
||||
! dx^10
|
||||
|
||||
! note the sign (-1)^r-1, now r=5
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
|
||||
if(i>imin+4 .and. i < imax-4 .and. &
|
||||
j>jmin+4 .and. j < jmax-4 .and. &
|
||||
k>kmin+4 .and. k < kmax-4) then
|
||||
! x direction
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( &
|
||||
(fh(i-5,j,k)+fh(i+5,j,k)) &
|
||||
- F10 * (fh(i-4,j,k)+fh(i+4,j,k)) &
|
||||
+ F45 * (fh(i-3,j,k)+fh(i+3,j,k)) &
|
||||
- F120* (fh(i-2,j,k)+fh(i+2,j,k)) &
|
||||
+ F210* (fh(i-1,j,k)+fh(i+1,j,k)) &
|
||||
- F252 * fh(i,j,k) )
|
||||
! y direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( &
|
||||
(fh(i,j-5,k)+fh(i,j+5,k)) &
|
||||
- F10 * (fh(i,j-4,k)+fh(i,j+4,k)) &
|
||||
+ F45 * (fh(i,j-3,k)+fh(i,j+3,k)) &
|
||||
- F120* (fh(i,j-2,k)+fh(i,j+2,k)) &
|
||||
+ F210* (fh(i,j-1,k)+fh(i,j+1,k)) &
|
||||
- F252 * fh(i,j,k) )
|
||||
! z direction
|
||||
|
||||
f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( &
|
||||
(fh(i,j,k-5)+fh(i,j,k+5)) &
|
||||
- F10 * (fh(i,j,k-4)+fh(i,j,k+4)) &
|
||||
+ F45 * (fh(i,j,k-3)+fh(i,j,k+3)) &
|
||||
- F120* (fh(i,j,k-2)+fh(i,j,k+2)) &
|
||||
+ F210* (fh(i,j,k-1)+fh(i,j,k+1)) &
|
||||
- F252 * fh(i,j,k) )
|
||||
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine kodis
|
||||
|
||||
#endif
|
||||
42
AMSS_NCKU_source/KO_dissipation/kodiss.h
Normal file
42
AMSS_NCKU_source/KO_dissipation/kodiss.h
Normal file
@@ -0,0 +1,42 @@
|
||||
|
||||
#ifndef KODISS_H
|
||||
#define KODISS_H
|
||||
|
||||
#ifdef fortran1
|
||||
#define f_kodis_sh kodis_sh
|
||||
#define f_kodis_shcr kodis_shcr
|
||||
#define f_kodis_shor kodis_shor
|
||||
#endif
|
||||
#ifdef fortran2
|
||||
#define f_kodis_sh KODIS_SH
|
||||
#define f_kodis_shcr KODIS_SHCR
|
||||
#define f_kodis_shor KODIS_SHOR
|
||||
#endif
|
||||
#ifdef fortran3
|
||||
#define f_kodis_sh kodis_sh_
|
||||
#define f_kodis_shcr kodis_shcr_
|
||||
#define f_kodis_shor kodis_shor_
|
||||
#endif
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_kodis_sh(int *, double *, double *, double *,
|
||||
double *, double *,
|
||||
double *, int &, double &, int &);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_kodis_shcr(int *, double *, double *, double *,
|
||||
double *, double *,
|
||||
double *, int &, double &, int &);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_kodis_shor(int *, double *, double *, double *,
|
||||
double *, double *,
|
||||
double *, int &, double &, int &);
|
||||
}
|
||||
|
||||
#endif /* KODISS_H */
|
||||
117
AMSS_NCKU_source/KO_dissipation/kodiss_c.C
Normal file
117
AMSS_NCKU_source/KO_dissipation/kodiss_c.C
Normal file
@@ -0,0 +1,117 @@
|
||||
#include "tool.h"
|
||||
|
||||
/*
|
||||
* C 版 kodis
|
||||
*
|
||||
* Fortran signature:
|
||||
* subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps)
|
||||
*
|
||||
* 约定:
|
||||
* X: ex1, Y: ex2, Z: ex3
|
||||
* f, f_rhs: ex1*ex2*ex3 按 idx_ex 布局
|
||||
* SoA[3]
|
||||
* eps: double
|
||||
*/
|
||||
void kodis(const int ex[3],
|
||||
const double *X, const double *Y, const double *Z,
|
||||
const double *f, double *f_rhs,
|
||||
const double SoA[3],
|
||||
int Symmetry, double eps)
|
||||
{
|
||||
const double ONE = 1.0, SIX = 6.0, FIT = 15.0, TWT = 20.0;
|
||||
const double cof = 64.0; // 2^6
|
||||
const int NO_SYMM = 0, OCTANT = 2;
|
||||
|
||||
const int ex1 = ex[0], ex2 = ex[1], ex3 = ex[2];
|
||||
|
||||
// Fortran: dX = X(2)-X(1) -> C: X[1]-X[0]
|
||||
const double dX = X[1] - X[0];
|
||||
const double dY = Y[1] - Y[0];
|
||||
const double dZ = Z[1] - Z[0];
|
||||
(void)ONE; // ONE 在原 Fortran 里只是参数,这里不一定用得上
|
||||
|
||||
// Fortran: imax=ex(1) 等是 1-based 上界
|
||||
const int imaxF = ex1;
|
||||
const int jmaxF = ex2;
|
||||
const int kmaxF = ex3;
|
||||
|
||||
// Fortran: imin=jmin=kmin=1,某些对称情况变 -2
|
||||
int iminF = 1, jminF = 1, kminF = 1;
|
||||
|
||||
if (Symmetry > NO_SYMM && fabs(Z[0]) < dZ) kminF = -2;
|
||||
if (Symmetry == OCTANT && fabs(X[0]) < dX) iminF = -2;
|
||||
if (Symmetry == OCTANT && fabs(Y[0]) < dY) jminF = -2;
|
||||
|
||||
// 分配 fh:大小 (ex1+3)*(ex2+3)*(ex3+3),对应 ord=3
|
||||
const size_t nx = (size_t)ex1 + 3;
|
||||
const size_t ny = (size_t)ex2 + 3;
|
||||
const size_t nz = (size_t)ex3 + 3;
|
||||
const size_t fh_size = nx * ny * nz;
|
||||
|
||||
double *fh = (double*)malloc(fh_size * sizeof(double));
|
||||
if (!fh) return;
|
||||
|
||||
// Fortran: call symmetry_bd(3,ex,f,fh,SoA)
|
||||
symmetry_bd(3, ex, f, fh, SoA);
|
||||
|
||||
/*
|
||||
* Fortran loops:
|
||||
* do k=1,ex3
|
||||
* do j=1,ex2
|
||||
* do i=1,ex1
|
||||
*
|
||||
* C: k0=0..ex3-1, j0=0..ex2-1, i0=0..ex1-1
|
||||
* 并定义 Fortran index: iF=i0+1, ...
|
||||
*/
|
||||
// 收紧循环范围:只遍历满足 iF±3/jF±3/kF±3 条件的内部点
|
||||
// iF-3 >= iminF => iF >= iminF+3 => i0 >= iminF+2 (因为 iF=i0+1)
|
||||
// iF+3 <= imaxF => iF <= imaxF-3 => i0 <= imaxF-4
|
||||
const int i0_lo = (iminF + 2 > 0) ? iminF + 2 : 0;
|
||||
const int j0_lo = (jminF + 2 > 0) ? jminF + 2 : 0;
|
||||
const int k0_lo = (kminF + 2 > 0) ? kminF + 2 : 0;
|
||||
const int i0_hi = imaxF - 4; // inclusive
|
||||
const int j0_hi = jmaxF - 4;
|
||||
const int k0_hi = kmaxF - 4;
|
||||
|
||||
if (i0_lo > i0_hi || j0_lo > j0_hi || k0_lo > k0_hi) {
|
||||
free(fh);
|
||||
return;
|
||||
}
|
||||
|
||||
for (int k0 = k0_lo; k0 <= k0_hi; ++k0) {
|
||||
const int kF = k0 + 1;
|
||||
for (int j0 = j0_lo; j0 <= j0_hi; ++j0) {
|
||||
const int jF = j0 + 1;
|
||||
for (int i0 = i0_lo; i0 <= i0_hi; ++i0) {
|
||||
const int iF = i0 + 1;
|
||||
|
||||
const size_t p = idx_ex(i0, j0, k0, ex);
|
||||
|
||||
// 三个方向各一份同型的 7 点组合(实际上是对称的 6th-order dissipation/filter 核)
|
||||
const double Dx_term =
|
||||
( (fh[idx_fh_F(iF - 3, jF, kF, ex)] + fh[idx_fh_F(iF + 3, jF, kF, ex)]) -
|
||||
SIX * (fh[idx_fh_F(iF - 2, jF, kF, ex)] + fh[idx_fh_F(iF + 2, jF, kF, ex)]) +
|
||||
FIT * (fh[idx_fh_F(iF - 1, jF, kF, ex)] + fh[idx_fh_F(iF + 1, jF, kF, ex)]) -
|
||||
TWT * fh[idx_fh_F(iF , jF, kF, ex)] ) / dX;
|
||||
|
||||
const double Dy_term =
|
||||
( (fh[idx_fh_F(iF, jF - 3, kF, ex)] + fh[idx_fh_F(iF, jF + 3, kF, ex)]) -
|
||||
SIX * (fh[idx_fh_F(iF, jF - 2, kF, ex)] + fh[idx_fh_F(iF, jF + 2, kF, ex)]) +
|
||||
FIT * (fh[idx_fh_F(iF, jF - 1, kF, ex)] + fh[idx_fh_F(iF, jF + 1, kF, ex)]) -
|
||||
TWT * fh[idx_fh_F(iF, jF , kF, ex)] ) / dY;
|
||||
|
||||
const double Dz_term =
|
||||
( (fh[idx_fh_F(iF, jF, kF - 3, ex)] + fh[idx_fh_F(iF, jF, kF + 3, ex)]) -
|
||||
SIX * (fh[idx_fh_F(iF, jF, kF - 2, ex)] + fh[idx_fh_F(iF, jF, kF + 2, ex)]) +
|
||||
FIT * (fh[idx_fh_F(iF, jF, kF - 1, ex)] + fh[idx_fh_F(iF, jF, kF + 1, ex)]) -
|
||||
TWT * fh[idx_fh_F(iF, jF, kF , ex)] ) / dZ;
|
||||
|
||||
// Fortran:
|
||||
// f_rhs(i,j,k) = f_rhs(i,j,k) + eps/cof*(Dx_term + Dy_term + Dz_term)
|
||||
f_rhs[p] += (eps / cof) * (Dx_term + Dy_term + Dz_term);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
free(fh);
|
||||
}
|
||||
1033
AMSS_NCKU_source/KO_dissipation/kodiss_sh.f90
Normal file
1033
AMSS_NCKU_source/KO_dissipation/kodiss_sh.f90
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user