initial
This commit is contained in:
163
initialize_sp.for
Normal file
163
initialize_sp.for
Normal file
@@ -0,0 +1,163 @@
|
||||
|
||||
! *** 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
|
||||
|
||||
Reference in New Issue
Block a user