187 lines
7.5 KiB
Fortran
187 lines
7.5 KiB
Fortran
|
|
! *** 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
|
|
|
|
!---------------------------------------------------------------------
|
|
!---------------------------------------------------------------------
|
|
!---------------------------------------------------------------------
|
|
! This subroutine initializes_bt the field variable u using
|
|
! tri-linear transfinite interpolation of the boundary values
|
|
!---------------------------------------------------------------------
|
|
subroutine initialize_bt ()
|
|
|
|
include 'header3d_bt.h'
|
|
integer :: i,j,k,m,ix,iy,iz
|
|
double precision :: xi,eta,zeta,pface(5,3,2),pxi,peta,pzeta,temp(
|
|
&5),xi1,yi1,zi1
|
|
xi = 0.0
|
|
eta = 0.0
|
|
zeta = 0.0
|
|
|
|
|
|
!$SPF PARALLEL_REG r0
|
|
! DVM$ PARALLEL (K,J,I) ON U(*,I,J,K), SHADOW_COMPUTE ,PRIVATE (M)
|
|
! DVM$ REGION OUT (U)
|
|
!---------------------------------------------------------------------
|
|
! Later (in compute_rhs) we compute 1/u for every element. A few of
|
|
! the corner elements are not used, but it convenient (and faster)
|
|
! to compute the whole thing with a simple loop. Make sure those
|
|
! values are nonzero by initializing the whole thing here.
|
|
!---------------------------------------------------------------------
|
|
do k = 0,imax - 1
|
|
do j = 0,imax - 1
|
|
do i = 0,imax - 1
|
|
do m = 1,5
|
|
u(m,i,j,k) = 1.0
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
!$SPF ANALYSIS(PRIVATE(temp, pface))
|
|
! DVM$ PARALLEL (K,J,I) ON U(*,I,J,K), PRIVATE (M,ZETA,ETA,XI,IX,IY,IZ,PX
|
|
! DVM$&I,PETA,PZETA,PFACE,XI1,YI1,ZI1,TEMP),SHADOW_COMPUTE
|
|
do k = 0,grid_points(3) - 1
|
|
do j = 0,grid_points(2) - 1
|
|
do i = 0,grid_points(1) - 1
|
|
zeta = dble (k) * dnzm1
|
|
eta = dble (j) * dnym1
|
|
xi = dble (i) * dnxm1
|
|
do ix = 1,2
|
|
|
|
! call exact_solution_bt(dble(ix-1), eta, zeta, Pface(1,1,ix))
|
|
xi1 = dble (ix - 1)
|
|
do m = 1,5
|
|
pface(m,1,ix) = ce(m,1) + xi1 * (ce(m,2) + xi1 * (c
|
|
&e(m,5) + xi1 * (ce(m,8) + xi1 * 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
|
|
|
|
! call exact_solution_bt(xi, dble(iy-1) , zeta, Pface(1,2,iy))
|
|
yi1 = 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)))) + yi1 * (ce(m,3) + yi1 * (
|
|
&ce(m,6) + yi1 * (ce(m,9) + yi1 * ce(m,12)))) + zeta * (ce(m,4) + z
|
|
&eta * (ce(m,7) + zeta * (ce(m,10) + zeta * ce(m,13))))
|
|
enddo
|
|
enddo
|
|
do iz = 1,2
|
|
|
|
! call exact_solution_bt(xi, eta, dble(iz-1), Pface(1,3,iz))
|
|
zi1 = 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)))) + zi1 * (ce(m,4) + zi
|
|
&1 * (ce(m,7) + zi1 * (ce(m,10) + zi1 * 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
|
|
if (i .eq. 0) then
|
|
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
|
|
if (i .eq. grid_points(1) - 1) then
|
|
xi = 1.0d0
|
|
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
|
|
if (j .eq. 0) then
|
|
zeta = dble (k) * dnzm1
|
|
xi = dble (i) * dnxm1
|
|
eta = 0.0d0
|
|
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
|
|
if (j .eq. grid_points(2) - 1) then
|
|
zeta = dble (k) * dnzm1
|
|
xi = dble (i) * dnxm1
|
|
eta = 1.0d0
|
|
|
|
! call exact_solution_bt(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
|
|
if (k .eq. 0) then
|
|
zeta = 0.0d0
|
|
xi = dble (i) * dnxm1
|
|
eta = dble (j) * dnym1
|
|
|
|
! call exact_solution_bt(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
|
|
if (k .eq. grid_points(3) - 1) then
|
|
zeta = 1.0d0
|
|
xi = dble (i) * dnxm1
|
|
eta = dble (j) * dnym1
|
|
|
|
! call exact_solution_bt(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
|
|
!$SPF END PARALLEL_REG
|
|
! DVM$ END REGION
|
|
return
|
|
end
|
|
|