164 lines
6.3 KiB
Plaintext
164 lines
6.3 KiB
Plaintext
|
|
||
|
|
! *** 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 initialize_sp ()
|
||
|
|
|
||
|
|
include 'header_sp.h'
|
||
|
|
integer :: i,j,k,m,ix,iy,iz
|
||
|
|
double precision :: xi,eta,zeta,pface(5,3,2),pxi,peta,pzeta,temp(
|
||
|
|
&5)
|
||
|
|
|
||
|
|
! DVM$ PARALLEL (K,J,I) ON U(*,I,J,K), PRIVATE (ZETA,ETA,XI,IX,PXI,M,PFAC
|
||
|
|
! DVM$&E,IY,PETA,IZ,PZETA,TEMP)
|
||
|
|
! DVM$ REGION
|
||
|
|
do k = 0,problem_size - 1
|
||
|
|
do j = 0,problem_size - 1
|
||
|
|
do i = 0,problem_size - 1
|
||
|
|
u(1,i,j,k) = 1.0
|
||
|
|
u(2,i,j,k) = 0.0
|
||
|
|
u(3,i,j,k) = 0.0
|
||
|
|
u(4,i,j,k) = 0.0
|
||
|
|
u(5,i,j,k) = 1.0
|
||
|
|
zeta = dble (k) * dnzm1
|
||
|
|
eta = dble (j) * dnym1
|
||
|
|
xi = dble (i) * dnxm1
|
||
|
|
do ix = 1,2
|
||
|
|
pxi = dble (ix - 1)
|
||
|
|
do m = 1,5
|
||
|
|
pface(m,1,ix) = ce(m,1) + pxi * (ce(m,2) + pxi * (c
|
||
|
|
&e(m,5) + pxi * (ce(m,8) + pxi * 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
|
||
|
|
enddo
|
||
|
|
do iy = 1,2
|
||
|
|
peta = dble (iy - 1)
|
||
|
|
do m = 1,5
|
||
|
|
pface(m,2,iy) = ce(m,1) + xi * (ce(m,2) + xi * (ce(
|
||
|
|
&m,5) + xi * (ce(m,8) + xi * ce(m,11)))) + peta * (ce(m,3) + peta *
|
||
|
|
& (ce(m,6) + peta * (ce(m,9) + peta * ce(m,12)))) + zeta * (ce(m,4)
|
||
|
|
& + zeta * (ce(m,7) + zeta * (ce(m,10) + zeta * ce(m,13))))
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do iz = 1,2
|
||
|
|
pzeta = dble (iz - 1)
|
||
|
|
do m = 1,5
|
||
|
|
pface(m,3,iz) = 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)))) + pzeta * (ce(m,4) +
|
||
|
|
&pzeta * (ce(m,7) + pzeta * (ce(m,10) + pzeta * ce(m,13))))
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do m = 1,5
|
||
|
|
pxi = xi * pface(m,1,2) + (1.0d0 - xi) * pface(m,1,1)
|
||
|
|
peta = eta * pface(m,2,2) + (1.0d0 - eta) * pface(m,2,
|
||
|
|
&1)
|
||
|
|
pzeta = zeta * pface(m,3,2) + (1.0d0 - zeta) * pface(m
|
||
|
|
&,3,1)
|
||
|
|
u(m,i,j,k) = pxi + peta + pzeta - pxi * peta - pxi * p
|
||
|
|
&zeta - peta * pzeta + pxi * peta * pzeta
|
||
|
|
enddo
|
||
|
|
zeta = dble (k) * dnzm1
|
||
|
|
eta = dble (j) * dnym1
|
||
|
|
xi = 0.0d0
|
||
|
|
if (i .eq. 0) then
|
||
|
|
|
||
|
|
! call exact_solution_sp(xi, eta, zeta, temp)
|
||
|
|
do m = 1,5
|
||
|
|
temp(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
|
||
|
|
u(m,i,j,k) = temp(m)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
xi = 1.0d0
|
||
|
|
if (i .eq. problem_size - 1) then
|
||
|
|
|
||
|
|
! call exact_solution_sp(xi, eta, zeta, temp)
|
||
|
|
do m = 1,5
|
||
|
|
temp(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
|
||
|
|
u(m,i,j,k) = temp(m)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
zeta = dble (k) * dnzm1
|
||
|
|
eta = 0.0d0
|
||
|
|
xi = dble (i) * dnxm1
|
||
|
|
if (j .eq. 0) then
|
||
|
|
|
||
|
|
! call exact_solution_sp(xi, eta, zeta, temp)
|
||
|
|
do m = 1,5
|
||
|
|
temp(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
|
||
|
|
u(m,i,j,k) = temp(m)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
eta = 1.0d0
|
||
|
|
if (j .eq. problem_size - 1) then
|
||
|
|
|
||
|
|
! call exact_solution_sp(xi, eta, zeta, temp)
|
||
|
|
do m = 1,5
|
||
|
|
temp(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
|
||
|
|
u(m,i,j,k) = temp(m)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
zeta = 0.0d0
|
||
|
|
eta = dble (j) * dnym1
|
||
|
|
xi = dble (i) * dnxm1
|
||
|
|
if (k .eq. 0) then
|
||
|
|
|
||
|
|
! call exact_solution_sp(xi, eta, zeta, temp)
|
||
|
|
do m = 1,5
|
||
|
|
temp(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
|
||
|
|
u(m,i,j,k) = temp(m)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
zeta = 1.0d0
|
||
|
|
if (k .eq. problem_size - 1) then
|
||
|
|
|
||
|
|
! call exact_solution_sp(xi, eta, zeta, temp)
|
||
|
|
do m = 1,5
|
||
|
|
temp(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
|
||
|
|
u(m,i,j,k) = temp(m)
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
! DVM$ END REGION
|
||
|
|
return
|
||
|
|
end
|
||
|
|
|