xnpster/spbt
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

initial

Browse Source
This commit is contained in:
Mikhail Kocharmin
2025-05-06 22:04:43 +03:00
commit 784a8f2ec7
29 changed files with 5922 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

280
exact_rhs_bt.for Normal file
View File

@@ -0,0 +1,280 @@
! *** generated by SAPFOR with version 2412 and build date: Apr 29 2025 22:44:14
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine exact_rhs_bt ()
include 'header3d_bt.h'
double precision :: dtemp(5),xi,eta,zeta,dtpp
integer :: m,i,j,k,ip1,im1,jp1,p,p1,jm1,km1,kp1,z
double precision :: ue_((-(2)):2,5),buf_((-(2)):2,5),cuf_((-(2)):
&2),q_((-(2)):2)
! DVM$ PARALLEL (K,J,I) ON FORCING(*,I,J,K), PRIVATE (M)
! DVM$ REGION
do k = 0,problem_size - 1
do j = 0,problem_size - 1
do i = 0,problem_size - 1
do m = 1,5
forcing(m,i,j,k) = 0.0d0
enddo
enddo
enddo
enddo
! DVM$ PARALLEL (K,J,I) ON FORCING(*,I,J,K), PRIVATE (ZETA,ETA,XI,M,DTEMP
! DVM$&,BUF_,CUF_,Q_,DTPP,Z,UE_)
!---------------------------------------------------------------------
! xi-direction flux differences
!---------------------------------------------------------------------
do k = 1,problem_size - 2
do j = 1,problem_size - 2
do i = 1,problem_size - 2
zeta = dble (k) * dnzm1
eta = dble (j) * dnym1
do z = (-(2)),2
xi = dble (i + z) * dnxm1
do m = 1,5
dtemp(m) = ce(m,1) + xi * (ce(m,2) + xi * (ce(m,5)
&+ xi * (ce(m,8) + xi * ce(m,11)))) + eta * (ce(m,3) + eta * (ce(m,
&6) + eta * (ce(m,9) + eta * ce(m,12)))) + zeta * (ce(m,4) + zeta *
& (ce(m,7) + zeta * (ce(m,10) + zeta * ce(m,13))))
enddo
do m = 1,5
ue_(z,m) = dtemp(m)
enddo
dtpp = 1.0d0 / dtemp(1)
do m = 2,5
buf_(z,m) = dtpp * dtemp(m)
enddo
cuf_(z) = buf_(z,2) * buf_(z,2)
buf_(z,1) = cuf_(z) + buf_(z,3) * buf_(z,3) + buf_(z,4
&) * buf_(z,4)
q_(z) = 0.5d0 * (buf_(z,2) * ue_(z,2) + buf_(z,3) * ue
&_(z,3) + buf_(z,4) * ue_(z,4))
enddo
forcing(1,i,j,k) = forcing(1,i,j,k) - tx2 * (ue_(1,2) - u
&e_((-(1)),2)) + dx1tx1 * (ue_(1,1) - 2.0d0 * ue_(0,1) + ue_((-(1))
&,1))
forcing(2,i,j,k) = forcing(2,i,j,k) - tx2 * (ue_(1,2) * b
&uf_(1,2) + c2 * (ue_(1,5) - q_(1)) - (ue_((-(1)),2) * buf_((-(1)),
&2) + c2 * (ue_((-(1)),5) - q_((-(1)))))) + xxcon1 * (buf_(1,2) - 2
&.0d0 * buf_(0,2) + buf_((-(1)),2)) + dx2tx1 * (ue_(1,2) - 2.0d0 *
&ue_(0,2) + ue_((-(1)),2))
forcing(3,i,j,k) = forcing(3,i,j,k) - tx2 * (ue_(1,3) * b
&uf_(1,2) - ue_((-(1)),3) * buf_((-(1)),2)) + xxcon2 * (buf_(1,3) -
& 2.0d0 * buf_(0,3) + buf_((-(1)),3)) + dx3tx1 * (ue_(1,3) - 2.0d0
&* ue_(0,3) + ue_((-(1)),3))
forcing(4,i,j,k) = forcing(4,i,j,k) - tx2 * (ue_(1,4) * b
&uf_(1,2) - ue_((-(1)),4) * buf_((-(1)),2)) + xxcon2 * (buf_(1,4) -
& 2.0d0 * buf_(0,4) + buf_((-(1)),4)) + dx4tx1 * (ue_(1,4) - 2.0d0
&* ue_(0,4) + ue_((-(1)),4))
forcing(5,i,j,k) = forcing(5,i,j,k) - tx2 * (buf_(1,2) *
&(c1 * ue_(1,5) - c2 * q_(1)) - buf_((-(1)),2) * (c1 * ue_((-(1)),5
&) - c2 * q_((-(1))))) + 0.5d0 * xxcon3 * (buf_(1,1) - 2.0d0 * buf_
&(0,1) + buf_((-(1)),1)) + xxcon4 * (cuf_(1) - 2.0d0 * cuf_(0) + cu
&f_((-(1)))) + xxcon5 * (buf_(1,5) - 2.0d0 * buf_(0,5) + buf_((-(1)
&),5)) + dx5tx1 * (ue_(1,5) - 2.0d0 * ue_(0,5) + ue_((-(1)),5))
do m = 1,5
if (i .eq. 1) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (5.0d0
& * ue_(0,m) - 4.0d0 * ue_(1,m) + ue_(2,m))
else if (i .eq. 2) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * ((-(4.
&0d0)) * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(1,m) + ue_(
&2,m))
else if (i .eq. problem_size - 3) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(
&1,m))
else if (i .eq. problem_size - 2) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 5.0d0 * ue_(0,m))
else
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(
&1,m) + ue_(2,m))
endif
enddo
enddo
enddo
enddo
! DVM$ PARALLEL (K,J,I) ON FORCING(*,I,J,K), PRIVATE (ZETA,ETA,XI,M,DTEMP
! DVM$&,BUF_,CUF_,Q_,DTPP,Z,UE_)
!---------------------------------------------------------------------
! eta-direction flux differences
!---------------------------------------------------------------------
do k = 1,problem_size - 2
do j = 1,problem_size - 2
do i = 1,problem_size - 2
zeta = dble (k) * dnzm1
xi = dble (i) * dnxm1
do z = (-(2)),2
eta = dble (j + z) * dnym1
do m = 1,5
dtemp(m) = ce(m,1) + xi * (ce(m,2) + xi * (ce(m,5)
&+ xi * (ce(m,8) + xi * ce(m,11)))) + eta * (ce(m,3) + eta * (ce(m,
&6) + eta * (ce(m,9) + eta * ce(m,12)))) + zeta * (ce(m,4) + zeta *
& (ce(m,7) + zeta * (ce(m,10) + zeta * ce(m,13))))
enddo
do m = 1,5
ue_(z,m) = dtemp(m)
enddo
dtpp = 1.0d0 / dtemp(1)
do m = 2,5
buf_(z,m) = dtpp * dtemp(m)
enddo
cuf_(z) = buf_(z,3) * buf_(z,3)
buf_(z,1) = cuf_(z) + buf_(z,2) * buf_(z,2) + buf_(z,4
&) * buf_(z,4)
q_(z) = 0.5d0 * (buf_(z,2) * ue_(z,2) + buf_(z,3) * ue
&_(z,3) + buf_(z,4) * ue_(z,4))
enddo
forcing(1,i,j,k) = forcing(1,i,j,k) - ty2 * (ue_(1,3) - u
&e_((-(1)),3)) + dy1ty1 * (ue_(1,1) - 2.0d0 * ue_(0,1) + ue_((-(1))
&,1))
forcing(2,i,j,k) = forcing(2,i,j,k) - ty2 * (ue_(1,2) * b
&uf_(1,3) - ue_((-(1)),2) * buf_((-(1)),3)) + yycon2 * (buf_(1,2) -
& 2.0d0 * buf_(0,2) + buf_((-(1)),2)) + dy2ty1 * (ue_(1,2) - 2.0 *
&ue_(0,2) + ue_((-(1)),2))
forcing(3,i,j,k) = forcing(3,i,j,k) - ty2 * (ue_(1,3) * b
&uf_(1,3) + c2 * (ue_(1,5) - q_(1)) - (ue_((-(1)),3) * buf_((-(1)),
&3) + c2 * (ue_((-(1)),5) - q_((-(1)))))) + yycon1 * (buf_(1,3) - 2
&.0d0 * buf_(0,3) + buf_((-(1)),3)) + dy3ty1 * (ue_(1,3) - 2.0d0 *
&ue_(0,3) + ue_((-(1)),3))
forcing(4,i,j,k) = forcing(4,i,j,k) - ty2 * (ue_(1,4) * b
&uf_(1,3) - ue_((-(1)),4) * buf_((-(1)),3)) + yycon2 * (buf_(1,4) -
& 2.0d0 * buf_(0,4) + buf_((-(1)),4)) + dy4ty1 * (ue_(1,4) - 2.0d0
&* ue_(0,4) + ue_((-(1)),4))
forcing(5,i,j,k) = forcing(5,i,j,k) - ty2 * (buf_(1,3) *
&(c1 * ue_(1,5) - c2 * q_(1)) - buf_((-(1)),3) * (c1 * ue_((-(1)),5
&) - c2 * q_((-(1))))) + 0.5d0 * yycon3 * (buf_(1,1) - 2.0d0 * buf_
&(0,1) + buf_((-(1)),1)) + yycon4 * (cuf_(1) - 2.0d0 * cuf_(0) + cu
&f_((-(1)))) + yycon5 * (buf_(1,5) - 2.0d0 * buf_(0,5) + buf_((-(1)
&),5)) + dy5ty1 * (ue_(1,5) - 2.0d0 * ue_(0,5) + ue_((-(1)),5))
do m = 1,5
if (j .eq. 1) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (5.0d0
& * ue_(0,m) - 4.0d0 * ue_(1,m) + ue_(2,m))
else if (j .eq. 2) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * ((-(4.
&0d0)) * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(1,m) + ue_(
&2,m))
else if (j .eq. problem_size - 3) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(
&1,m))
else if (j .eq. problem_size - 2) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 5.0d0 * ue_(0,m))
else
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(
&1,m) + ue_(2,m))
endif
enddo
enddo
enddo
enddo
! DVM$ PARALLEL (K,J,I) ON FORCING(*,I,J,K), PRIVATE (ZETA,ETA,XI,M,BUF_,
! DVM$&CUF_,Q_,UE_,DTPP,DTEMP,Z)
!---------------------------------------------------------------------
! zeta-direction flux differences
!---------------------------------------------------------------------
do k = 1,problem_size - 2
do j = 1,problem_size - 2
do i = 1,problem_size - 2
xi = dble (i) * dnxm1
eta = dble (j) * dnym1
do z = (-(2)),2
zeta = dble (k + z) * dnzm1
do m = 1,5
dtemp(m) = ce(m,1) + xi * (ce(m,2) + xi * (ce(m,5)
&+ xi * (ce(m,8) + xi * ce(m,11)))) + eta * (ce(m,3) + eta * (ce(m,
&6) + eta * (ce(m,9) + eta * ce(m,12)))) + zeta * (ce(m,4) + zeta *
& (ce(m,7) + zeta * (ce(m,10) + zeta * ce(m,13))))
enddo
do m = 1,5
ue_(z,m) = dtemp(m)
enddo
dtpp = 1.0d0 / dtemp(1)
do m = 2,5
buf_(z,m) = dtpp * dtemp(m)
enddo
cuf_(z) = buf_(z,4) * buf_(z,4)
buf_(z,1) = cuf_(z) + buf_(z,2) * buf_(z,2) + buf_(z,3
&) * buf_(z,3)
q_(z) = 0.5d0 * (buf_(z,2) * ue_(z,2) + buf_(z,3) * ue
&_(z,3) + buf_(z,4) * ue_(z,4))
enddo
forcing(1,i,j,k) = forcing(1,i,j,k) - tz2 * (ue_(1,4) - u
&e_((-(1)),4)) + dz1tz1 * (ue_(1,1) - 2.0d0 * ue_(0,1) + ue_((-(1))
&,1))
forcing(2,i,j,k) = forcing(2,i,j,k) - tz2 * (ue_(1,2) * b
&uf_(1,4) - ue_((-(1)),2) * buf_((-(1)),4)) + zzcon2 * (buf_(1,2) -
& 2.0d0 * buf_(0,2) + buf_((-(1)),2)) + dz2tz1 * (ue_(1,2) - 2.0d0
&* ue_(0,2) + ue_((-(1)),2))
forcing(3,i,j,k) = forcing(3,i,j,k) - tz2 * (ue_(1,3) * b
&uf_(1,4) - ue_((-(1)),3) * buf_((-(1)),4)) + zzcon2 * (buf_(1,3) -
& 2.0d0 * buf_(0,3) + buf_((-(1)),3)) + dz3tz1 * (ue_(1,3) - 2.0d0
&* ue_(0,3) + ue_((-(1)),3))
forcing(4,i,j,k) = forcing(4,i,j,k) - tz2 * (ue_(1,4) * b
&uf_(1,4) + c2 * (ue_(1,5) - q_(1)) - (ue_((-(1)),4) * buf_((-(1)),
&4) + c2 * (ue_((-(1)),5) - q_((-(1)))))) + zzcon1 * (buf_(1,4) - 2
&.0d0 * buf_(0,4) + buf_((-(1)),4)) + dz4tz1 * (ue_(1,4) - 2.0d0 *
&ue_(0,4) + ue_((-(1)),4))
forcing(5,i,j,k) = forcing(5,i,j,k) - tz2 * (buf_(1,4) *
&(c1 * ue_(1,5) - c2 * q_(1)) - buf_((-(1)),4) * (c1 * ue_((-(1)),5
&) - c2 * q_((-(1))))) + 0.5d0 * zzcon3 * (buf_(1,1) - 2.0d0 * buf_
&(0,1) + buf_((-(1)),1)) + zzcon4 * (cuf_(1) - 2.0d0 * cuf_(0) + cu
&f_((-(1)))) + zzcon5 * (buf_(1,5) - 2.0d0 * buf_(0,5) + buf_((-(1)
&),5)) + dz5tz1 * (ue_(1,5) - 2.0d0 * ue_(0,5) + ue_((-(1)),5))
do m = 1,5
if (k .eq. 1) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (5.0d0
& * ue_(0,m) - 4.0d0 * ue_(1,m) + ue_(2,m))
else if (k .eq. 2) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * ((-(4.
&0d0)) * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(1,m) + ue_(
&2,m))
else if (k .eq. problem_size - 3) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(
&1,m))
else if (k .eq. problem_size - 2) then
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 5.0d0 * ue_(0,m))
else
forcing(m,i,j,k) = forcing(m,i,j,k) - dssp * (ue_((
&-(2)),m) - 4.0d0 * ue_((-(1)),m) + 6.0d0 * ue_(0,m) - 4.0d0 * ue_(
&1,m) + ue_(2,m))
endif
enddo
enddo
enddo
enddo
! DVM$ PARALLEL (K,J,I) ON FORCING(*,I,J,K), PRIVATE (M)
!---------------------------------------------------------------------
! now change the sign of the forcing function,
!---------------------------------------------------------------------
do k = 1,problem_size - 2
do j = 1,problem_size - 2
do i = 1,problem_size - 2
do m = 1,5
forcing(m,i,j,k) = (-(1.d0)) * forcing(m,i,j,k)
enddo
enddo
enddo
enddo
! DVM$ END REGION
return
end