! *** 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