initial
This commit is contained in:
332
y_solve_sp.for
Normal file
332
y_solve_sp.for
Normal file
@@ -0,0 +1,332 @@
|
||||
|
||||
! *** 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 y_solve_sp ()
|
||||
|
||||
include 'header_sp.h'
|
||||
integer :: i,j,k,j1,j2,m,m1
|
||||
double precision :: ru1,fac1,fac2,rhs__(5,0:2),t1,t2
|
||||
double precision :: lhs__(5,0:2),lhsm__(5,0:2),lhsp__(5,0:2)
|
||||
|
||||
!---------------------------------------------------------------------
|
||||
!---------------------------------------------------------------------
|
||||
|
||||
!$SPF PARALLEL_REG r0
|
||||
!$SPF ANALYSIS(PRIVATE(LHS__,LHSP__,LHSM__,RHS__))
|
||||
! DVM$ PARALLEL (K,I) ON U(*,I,*,K), CUDA_BLOCK (32,4),PRIVATE (M,J1,J2,F
|
||||
! DVM$&AC1,FAC2,RU1,LHS__,LHSP__,LHSM__,J,RHS__,T1,T2)
|
||||
! DVM$ REGION LOCAL (LHS)
|
||||
do k = 1,nz2
|
||||
do i = 1,nx2
|
||||
lhs__(1,0) = 0.0d0
|
||||
lhsp__(1,0) = 0.0d0
|
||||
lhsm__(1,0) = 0.0d0
|
||||
lhs__(2,0) = 0.0d0
|
||||
lhsp__(2,0) = 0.0d0
|
||||
lhsm__(2,0) = 0.0d0
|
||||
lhs__(3,0) = 1.0d0
|
||||
lhsp__(3,0) = 1.0d0
|
||||
lhsm__(3,0) = 1.0d0
|
||||
lhs__(4,0) = 0.0d0
|
||||
lhsp__(4,0) = 0.0d0
|
||||
lhsm__(4,0) = 0.0d0
|
||||
lhs__(5,0) = 0.0d0
|
||||
lhsp__(5,0) = 0.0d0
|
||||
lhsm__(5,0) = 0.0d0
|
||||
lhs__(1,1) = 0.0d0
|
||||
ru1 = c3c4 * 1.0d0 / u(1,i,1 - 1,k)
|
||||
ru1 = dmax1 (dy3 + con43 * ru1,dy5 + c1c5 * ru1,dymax + ru1,
|
||||
&dy1)
|
||||
lhs__(2,1) = (-(dtty2)) * vs(i,1 - 1,k) - dtty1 * ru1
|
||||
ru1 = c3c4 * 1.0d0 / u(1,i,1,k)
|
||||
ru1 = dmax1 (dy3 + con43 * ru1,dy5 + c1c5 * ru1,dymax + ru1,
|
||||
&dy1)
|
||||
lhs__(3,1) = 1.0d0 + c2dtty1 * ru1
|
||||
ru1 = c3c4 * 1.0d0 / u(1,i,1 + 1,k)
|
||||
ru1 = dmax1 (dy3 + con43 * ru1,dy5 + c1c5 * ru1,dymax + ru1,
|
||||
&dy1)
|
||||
lhs__(4,1) = dtty2 * vs(i,1 + 1,k) - dtty1 * ru1
|
||||
lhs__(5,1) = 0.0d0
|
||||
lhs__(3,1) = lhs__(3,1) + comz5
|
||||
lhs__(4,1) = lhs__(4,1) - comz4
|
||||
lhs__(5,1) = lhs__(5,1) + comz1
|
||||
lhsp__(1,1) = lhs__(1,1)
|
||||
lhsp__(2,1) = lhs__(2,1) - dtty2 * speed(i,1 - 1,k)
|
||||
lhsp__(3,1) = lhs__(3,1)
|
||||
lhsp__(4,1) = lhs__(4,1) + dtty2 * speed(i,1 + 1,k)
|
||||
lhsp__(5,1) = lhs__(5,1)
|
||||
lhsm__(1,1) = lhs__(1,1)
|
||||
lhsm__(2,1) = lhs__(2,1) + dtty2 * speed(i,1 - 1,k)
|
||||
lhsm__(3,1) = lhs__(3,1)
|
||||
lhsm__(4,1) = lhs__(4,1) - dtty2 * speed(i,1 + 1,k)
|
||||
lhsm__(5,1) = lhs__(5,1)
|
||||
do j = 0,ny2 + 1
|
||||
if (j + 2 .lt. ny2 + 1) then
|
||||
m = j + 2
|
||||
lhs__(1,2) = 0.0d0
|
||||
ru1 = c3c4 * 1.0d0 / u(1,i,m - 1,k)
|
||||
ru1 = dmax1 (dy3 + con43 * ru1,dy5 + c1c5 * ru1,dymax
|
||||
&+ ru1,dy1)
|
||||
lhs__(2,2) = (-(dtty2)) * vs(i,m - 1,k) - dtty1 * ru1
|
||||
ru1 = c3c4 * 1.0d0 / u(1,i,m,k)
|
||||
ru1 = dmax1 (dy3 + con43 * ru1,dy5 + c1c5 * ru1,dymax
|
||||
&+ ru1,dy1)
|
||||
lhs__(3,2) = 1.0d0 + c2dtty1 * ru1
|
||||
ru1 = c3c4 * 1.0d0 / u(1,i,m + 1,k)
|
||||
ru1 = dmax1 (dy3 + con43 * ru1,dy5 + c1c5 * ru1,dymax
|
||||
&+ ru1,dy1)
|
||||
lhs__(4,2) = dtty2 * vs(i,m + 1,k) - dtty1 * ru1
|
||||
lhs__(5,2) = 0.0d0
|
||||
if (m .eq. 1) then
|
||||
lhs__(3,2) = lhs__(3,2) + comz5
|
||||
lhs__(4,2) = lhs__(4,2) - comz4
|
||||
lhs__(5,2) = lhs__(5,2) + comz1
|
||||
else if (m .eq. 2) then
|
||||
lhs__(2,2) = lhs__(2,2) - comz4
|
||||
lhs__(3,2) = lhs__(3,2) + comz6
|
||||
lhs__(4,2) = lhs__(4,2) - comz4
|
||||
lhs__(5,2) = lhs__(5,2) + comz1
|
||||
else if (m .ge. 3 .and. m .le. ny2 - 2) then
|
||||
lhs__(1,2) = lhs__(1,2) + comz1
|
||||
lhs__(2,2) = lhs__(2,2) - comz4
|
||||
lhs__(3,2) = lhs__(3,2) + comz6
|
||||
lhs__(4,2) = lhs__(4,2) - comz4
|
||||
lhs__(5,2) = lhs__(5,2) + comz1
|
||||
else if (m .eq. ny2 - 1) then
|
||||
lhs__(1,2) = lhs__(1,2) + comz1
|
||||
lhs__(2,2) = lhs__(2,2) - comz4
|
||||
lhs__(3,2) = lhs__(3,2) + comz6
|
||||
lhs__(4,2) = lhs__(4,2) - comz4
|
||||
else if (m .eq. ny2) then
|
||||
lhs__(1,2) = lhs__(1,2) + comz1
|
||||
lhs__(2,2) = lhs__(2,2) - comz4
|
||||
lhs__(3,2) = lhs__(3,2) + comz5
|
||||
endif
|
||||
lhsp__(1,2) = lhs__(1,2)
|
||||
lhsp__(2,2) = lhs__(2,2) - dtty2 * speed(i,m - 1,k)
|
||||
lhsp__(3,2) = lhs__(3,2)
|
||||
lhsp__(4,2) = lhs__(4,2) + dtty2 * speed(i,m + 1,k)
|
||||
lhsp__(5,2) = lhs__(5,2)
|
||||
lhsm__(1,2) = lhs__(1,2)
|
||||
lhsm__(2,2) = lhs__(2,2) + dtty2 * speed(i,m - 1,k)
|
||||
lhsm__(3,2) = lhs__(3,2)
|
||||
lhsm__(4,2) = lhs__(4,2) - dtty2 * speed(i,m + 1,k)
|
||||
lhsm__(5,2) = lhs__(5,2)
|
||||
else if (j + 2 .eq. ny2 + 1) then
|
||||
lhs__(1,2) = 0.0d0
|
||||
lhsp__(1,2) = 0.0d0
|
||||
lhsm__(1,2) = 0.0d0
|
||||
lhs__(2,2) = 0.0d0
|
||||
lhsp__(2,2) = 0.0d0
|
||||
lhsm__(2,2) = 0.0d0
|
||||
lhs__(3,2) = 1.0d0
|
||||
lhsp__(3,2) = 1.0d0
|
||||
lhsm__(3,2) = 1.0d0
|
||||
lhs__(4,2) = 0.0d0
|
||||
lhsp__(4,2) = 0.0d0
|
||||
lhsm__(4,2) = 0.0d0
|
||||
lhs__(5,2) = 0.0d0
|
||||
lhsp__(5,2) = 0.0d0
|
||||
lhsm__(5,2) = 0.0d0
|
||||
endif
|
||||
|
||||
!********************************** end of init
|
||||
j1 = j + 1
|
||||
j2 = j + 2
|
||||
fac1 = 1.d0 / lhs__(3,0)
|
||||
lhs__(4,0) = fac1 * lhs__(4,0)
|
||||
lhs__(5,0) = fac1 * lhs__(5,0)
|
||||
do m = 1,3
|
||||
rhs(m,i,j,k) = fac1 * rhs(m,i,j,k)
|
||||
enddo
|
||||
if (j .le. ny2 - 1) then
|
||||
lhs__(3,1) = lhs__(3,1) - lhs__(2,1) * lhs__(4,0)
|
||||
lhs__(4,1) = lhs__(4,1) - lhs__(2,1) * lhs__(5,0)
|
||||
lhs__(2,2) = lhs__(2,2) - lhs__(1,2) * lhs__(4,0)
|
||||
lhs__(3,2) = lhs__(3,2) - lhs__(1,2) * lhs__(5,0)
|
||||
do m = 1,3
|
||||
rhs(m,i,j1,k) = rhs(m,i,j1,k) - lhs__(2,1) * rhs(m,
|
||||
&i,j,k)
|
||||
rhs(m,i,j2,k) = rhs(m,i,j2,k) - lhs__(1,2) * rhs(m,
|
||||
&i,j,k)
|
||||
enddo
|
||||
else
|
||||
lhs__(3,1) = lhs__(3,1) - lhs__(2,1) * lhs__(4,0)
|
||||
lhs__(4,1) = lhs__(4,1) - lhs__(2,1) * lhs__(5,0)
|
||||
fac2 = 1.d0 / lhs__(3,1)
|
||||
do m = 1,3
|
||||
rhs(m,i,j1,k) = rhs(m,i,j1,k) - lhs__(2,1) * rhs(m,
|
||||
&i,j,k)
|
||||
rhs(m,i,j1,k) = fac2 * rhs(m,i,j1,k)
|
||||
enddo
|
||||
endif
|
||||
m = 4
|
||||
fac1 = 1.d0 / lhsp__(3,0)
|
||||
lhsp__(4,0) = fac1 * lhsp__(4,0)
|
||||
lhsp__(5,0) = fac1 * lhsp__(5,0)
|
||||
rhs(m,i,j,k) = fac1 * rhs(m,i,j,k)
|
||||
lhsp__(3,1) = lhsp__(3,1) - lhsp__(2,1) * lhsp__(4,0)
|
||||
lhsp__(4,1) = lhsp__(4,1) - lhsp__(2,1) * lhsp__(5,0)
|
||||
rhs(m,i,j1,k) = rhs(m,i,j1,k) - lhsp__(2,1) * rhs(m,i,j,k
|
||||
&)
|
||||
if (j .lt. ny2) then
|
||||
lhsp__(2,2) = lhsp__(2,2) - lhsp__(1,2) * lhsp__(4,0)
|
||||
lhsp__(3,2) = lhsp__(3,2) - lhsp__(1,2) * lhsp__(5,0)
|
||||
rhs(m,i,j2,k) = rhs(m,i,j2,k) - lhsp__(1,2) * rhs(m,i,
|
||||
&j,k)
|
||||
endif
|
||||
m = 5
|
||||
fac1 = 1.d0 / lhsm__(3,0)
|
||||
lhsm__(4,0) = fac1 * lhsm__(4,0)
|
||||
lhsm__(5,0) = fac1 * lhsm__(5,0)
|
||||
rhs(m,i,j,k) = fac1 * rhs(m,i,j,k)
|
||||
lhsm__(3,1) = lhsm__(3,1) - lhsm__(2,1) * lhsm__(4,0)
|
||||
lhsm__(4,1) = lhsm__(4,1) - lhsm__(2,1) * lhsm__(5,0)
|
||||
rhs(m,i,j1,k) = rhs(m,i,j1,k) - lhsm__(2,1) * rhs(m,i,j,k
|
||||
&)
|
||||
if (j .lt. ny2) then
|
||||
lhsm__(2,2) = lhsm__(2,2) - lhsm__(1,2) * lhsm__(4,0)
|
||||
lhsm__(3,2) = lhsm__(3,2) - lhsm__(1,2) * lhsm__(5,0)
|
||||
rhs(m,i,j2,k) = rhs(m,i,j2,k) - lhsm__(1,2) * rhs(m,i,
|
||||
&j,k)
|
||||
endif
|
||||
if (j .eq. ny2) then
|
||||
rhs(4,i,j1,k) = rhs(4,i,j1,k) / lhsp__(3,1)
|
||||
rhs(5,i,j1,k) = rhs(5,i,j1,k) / lhsm__(3,1)
|
||||
do m = 1,3
|
||||
rhs(m,i,j,k) = rhs(m,i,j,k) - lhs__(4,0) * rhs(m,i,
|
||||
&j1,k)
|
||||
enddo
|
||||
rhs(4,i,j,k) = rhs(4,i,j,k) - lhsp__(4,0) * rhs(4,i,j1
|
||||
&,k)
|
||||
rhs(5,i,j,k) = rhs(5,i,j,k) - lhsm__(4,0) * rhs(5,i,j1
|
||||
&,k)
|
||||
endif
|
||||
lhs(0,4,i,j,k) = lhs__(4,0)
|
||||
lhs(1,4,i,j,k) = lhsp__(4,0)
|
||||
lhs(2,4,i,j,k) = lhsm__(4,0)
|
||||
lhs(0,5,i,j,k) = lhs__(5,0)
|
||||
lhs(1,5,i,j,k) = lhsp__(5,0)
|
||||
lhs(2,5,i,j,k) = lhsm__(5,0)
|
||||
lhs__(1,0) = lhs__(1,1)
|
||||
lhsp__(1,0) = lhsp__(1,1)
|
||||
lhsm__(1,0) = lhsm__(1,1)
|
||||
lhs__(1,1) = lhs__(1,2)
|
||||
lhsp__(1,1) = lhsp__(1,2)
|
||||
lhsm__(1,1) = lhsm__(1,2)
|
||||
lhs__(2,0) = lhs__(2,1)
|
||||
lhsp__(2,0) = lhsp__(2,1)
|
||||
lhsm__(2,0) = lhsm__(2,1)
|
||||
lhs__(2,1) = lhs__(2,2)
|
||||
lhsp__(2,1) = lhsp__(2,2)
|
||||
lhsm__(2,1) = lhsm__(2,2)
|
||||
lhs__(3,0) = lhs__(3,1)
|
||||
lhsp__(3,0) = lhsp__(3,1)
|
||||
lhsm__(3,0) = lhsm__(3,1)
|
||||
lhs__(3,1) = lhs__(3,2)
|
||||
lhsp__(3,1) = lhsp__(3,2)
|
||||
lhsm__(3,1) = lhsm__(3,2)
|
||||
lhs__(4,0) = lhs__(4,1)
|
||||
lhsp__(4,0) = lhsp__(4,1)
|
||||
lhsm__(4,0) = lhsm__(4,1)
|
||||
lhs__(4,1) = lhs__(4,2)
|
||||
lhsp__(4,1) = lhsp__(4,2)
|
||||
lhsm__(4,1) = lhsm__(4,2)
|
||||
lhs__(5,0) = lhs__(5,1)
|
||||
lhsp__(5,0) = lhsp__(5,1)
|
||||
lhsm__(5,0) = lhsm__(5,1)
|
||||
lhs__(5,1) = lhs__(5,2)
|
||||
lhsp__(5,1) = lhsp__(5,2)
|
||||
lhsm__(5,1) = lhsm__(5,2)
|
||||
enddo
|
||||
j = problem_size - 3
|
||||
rhs__(1,2) = rhs(1,i,j + 2,k)
|
||||
rhs__(2,2) = rhs(2,i,j + 2,k)
|
||||
rhs__(3,2) = rhs(3,i,j + 2,k)
|
||||
rhs__(4,2) = rhs(4,i,j + 2,k)
|
||||
rhs__(5,2) = rhs(5,i,j + 2,k)
|
||||
rhs__(1,1) = rhs(1,i,j + 1,k)
|
||||
rhs__(2,1) = rhs(2,i,j + 1,k)
|
||||
rhs__(3,1) = rhs(3,i,j + 1,k)
|
||||
rhs__(4,1) = rhs(4,i,j + 1,k)
|
||||
rhs__(5,1) = rhs(5,i,j + 1,k)
|
||||
rhs__(1,0) = rhs(1,i,j,k)
|
||||
rhs__(2,0) = rhs(2,i,j,k)
|
||||
rhs__(3,0) = rhs(3,i,j,k)
|
||||
rhs__(4,0) = rhs(4,i,j,k)
|
||||
rhs__(5,0) = rhs(5,i,j,k)
|
||||
rhs__(1,0) = rhs__(1,0) - lhs(0,4,i,j,k) * rhs__(1,1) - lhs(
|
||||
&0,5,i,j,k) * rhs__(1,2)
|
||||
rhs__(2,0) = rhs__(2,0) - lhs(0,4,i,j,k) * rhs__(2,1) - lhs(
|
||||
&0,5,i,j,k) * rhs__(2,2)
|
||||
rhs__(3,0) = rhs__(3,0) - lhs(0,4,i,j,k) * rhs__(3,1) - lhs(
|
||||
&0,5,i,j,k) * rhs__(3,2)
|
||||
rhs__(4,0) = rhs__(4,0) - lhs(1,4,i,j,k) * rhs__(4,1) - lhs(
|
||||
&1,5,i,j,k) * rhs__(4,2)
|
||||
rhs__(5,0) = rhs__(5,0) - lhs(2,4,i,j,k) * rhs__(5,1) - lhs(
|
||||
&2,5,i,j,k) * rhs__(5,2)
|
||||
rhs__(1,2) = rhs__(1,1)
|
||||
rhs__(2,2) = rhs__(2,1)
|
||||
rhs__(3,2) = rhs__(3,1)
|
||||
rhs__(4,2) = rhs__(4,1)
|
||||
rhs__(5,2) = rhs__(5,1)
|
||||
rhs__(1,1) = rhs__(1,0)
|
||||
rhs__(2,1) = rhs__(2,0)
|
||||
rhs__(3,1) = rhs__(3,0)
|
||||
rhs__(4,1) = rhs__(4,0)
|
||||
rhs__(5,1) = rhs__(5,0)
|
||||
do j = problem_size - 4,0,(-(1))
|
||||
rhs__(1,0) = rhs(1,i,j,k)
|
||||
rhs__(2,0) = rhs(2,i,j,k)
|
||||
rhs__(3,0) = rhs(3,i,j,k)
|
||||
rhs__(4,0) = rhs(4,i,j,k)
|
||||
rhs__(5,0) = rhs(5,i,j,k)
|
||||
rhs__(1,0) = rhs__(1,0) - lhs(0,4,i,j,k) * rhs__(1,1) - l
|
||||
&hs(0,5,i,j,k) * rhs__(1,2)
|
||||
rhs__(2,0) = rhs__(2,0) - lhs(0,4,i,j,k) * rhs__(2,1) - l
|
||||
&hs(0,5,i,j,k) * rhs__(2,2)
|
||||
rhs__(3,0) = rhs__(3,0) - lhs(0,4,i,j,k) * rhs__(3,1) - l
|
||||
&hs(0,5,i,j,k) * rhs__(3,2)
|
||||
rhs__(4,0) = rhs__(4,0) - lhs(1,4,i,j,k) * rhs__(4,1) - l
|
||||
&hs(1,5,i,j,k) * rhs__(4,2)
|
||||
rhs__(5,0) = rhs__(5,0) - lhs(2,4,i,j,k) * rhs__(5,1) - l
|
||||
&hs(2,5,i,j,k) * rhs__(5,2)
|
||||
t1 = bt * rhs__(1,2)
|
||||
t2 = 0.5d0 * (rhs__(4,2) + rhs__(5,2))
|
||||
rhs(1,i,j + 2,k) = bt * (rhs__(4,2) - rhs__(5,2))
|
||||
rhs(2,i,j + 2,k) = (-(rhs__(3,2)))
|
||||
rhs(3,i,j + 2,k) = rhs__(2,2)
|
||||
rhs(4,i,j + 2,k) = (-(t1)) + t2
|
||||
rhs(5,i,j + 2,k) = t1 + t2
|
||||
rhs__(1,2) = rhs__(1,1)
|
||||
rhs__(2,2) = rhs__(2,1)
|
||||
rhs__(3,2) = rhs__(3,1)
|
||||
rhs__(4,2) = rhs__(4,1)
|
||||
rhs__(5,2) = rhs__(5,1)
|
||||
rhs__(1,1) = rhs__(1,0)
|
||||
rhs__(2,1) = rhs__(2,0)
|
||||
rhs__(3,1) = rhs__(3,0)
|
||||
rhs__(4,1) = rhs__(4,0)
|
||||
rhs__(5,1) = rhs__(5,0)
|
||||
enddo
|
||||
t1 = bt * rhs__(1,2)
|
||||
t2 = 0.5d0 * (rhs__(4,2) + rhs__(5,2))
|
||||
rhs(1,i,j + 2,k) = bt * (rhs__(4,2) - rhs__(5,2))
|
||||
rhs(2,i,j + 2,k) = (-(rhs__(3,2)))
|
||||
rhs(3,i,j + 2,k) = rhs__(2,2)
|
||||
rhs(4,i,j + 2,k) = (-(t1)) + t2
|
||||
rhs(5,i,j + 2,k) = t1 + t2
|
||||
enddo
|
||||
enddo
|
||||
!$SPF END PARALLEL_REG
|
||||
! DVM$ END REGION
|
||||
return
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user