281 lines
13 KiB
Fortran
281 lines
13 KiB
Fortran
|
|
! *** generated by SAPFOR with version 2415 and build date: May 4 2025 14:48:40
|
|
! *** Enabled options ***:
|
|
! *** maximum shadow width is 50 percent
|
|
! *** generated by SAPFOR
|
|
|
|
!---------------------------------------------------------------------
|
|
!---------------------------------------------------------------------
|
|
subroutine exact_rhs_sp ()
|
|
|
|
include 'header_sp.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
|
|
|