M/VisualSapfor
1
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

v++

Browse Source 
Папка для загрузок, и пропущенный баг с настройками визуализатора.
This commit is contained in:
02090095
2025-01-23 16:56:45 +03:00
parent 29176ebb4a
commit 6c0c103804
154 changed files with 61977 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
Downloads/bugreport_1737466258/test_routine_4/call.for Normal file
View File

@@ -0,0 +1,11 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

167
Downloads/bugreport_1737466258/test_routine_4/contains31.for Normal file
View File

@@ -0,0 +1,167 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

11
Downloads/bugreport_1737466258/test_routine_4/m1/call.for Normal file
View File

@@ -0,0 +1,11 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

166
Downloads/bugreport_1737466258/test_routine_4/m1/contains31.for Normal file
View File

@@ -0,0 +1,166 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

13
Downloads/bugreport_1737466258/test_routine_4/m1/sol.for Normal file
View File

@@ -0,0 +1,13 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

11
Downloads/bugreport_1737466258/test_routine_4/m2/call.for Normal file
View File

@@ -0,0 +1,11 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

167
Downloads/bugreport_1737466258/test_routine_4/m2/contains31.for Normal file
View File

@@ -0,0 +1,167 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

13
Downloads/bugreport_1737466258/test_routine_4/m2/sol.for Normal file
View File

@@ -0,0 +1,13 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

11
Downloads/bugreport_1737466258/test_routine_4/m3/call.for Normal file
View File

@@ -0,0 +1,11 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

167
Downloads/bugreport_1737466258/test_routine_4/m3/contains31.for Normal file
View File

@@ -0,0 +1,167 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

13
Downloads/bugreport_1737466258/test_routine_4/m3/sol.for Normal file
View File

@@ -0,0 +1,13 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

11
Downloads/bugreport_1737466258/test_routine_4/m4/call.for Normal file
View File

@@ -0,0 +1,11 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

167
Downloads/bugreport_1737466258/test_routine_4/m4/contains31.for Normal file
View File

@@ -0,0 +1,167 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

13
Downloads/bugreport_1737466258/test_routine_4/m4/sol.for Normal file
View File

@@ -0,0 +1,13 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

11
Downloads/bugreport_1737466258/test_routine_4/m5/call.for Normal file
View File

@@ -0,0 +1,11 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

167
Downloads/bugreport_1737466258/test_routine_4/m5/contains31.for Normal file
View File

@@ -0,0 +1,167 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

13
Downloads/bugreport_1737466258/test_routine_4/m5/sol.for Normal file
View File

@@ -0,0 +1,13 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

23
Downloads/bugreport_1737466258/test_routine_4/m5/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p1/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

236
Downloads/bugreport_1737466258/test_routine_4/p1/contains31.for Normal file
View File

@@ -0,0 +1,236 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,1:1 )
!DVM$ SHADOW a( 1:1,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(inout) a
intent(in) nz,ny,nx
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) b,a
intent(in) nz,ny,nx
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

19
Downloads/bugreport_1737466258/test_routine_4/p1/sol.for Normal file
View File

@@ -0,0 +1,19 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) nz,ny,nx,kk,jj,ii
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) nz,ny,nx,kk,jj,ii
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

3
Downloads/bugreport_1737466258/test_routine_4/p1/visualiser_data/spf.proj Normal file
View File

@@ -0,0 +1,3 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p1/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p1/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p1/visualiser_data/options/sol.for.dep

12
Downloads/bugreport_1737466258/test_routine_4/p10/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p10/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,1:1 )
!DVM$ SHADOW a( 1:1,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p10/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

34
Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/Sapfor_log.txt Normal file
View File

@@ -0,0 +1,34 @@
Tue Jan 21 16:13:23 2025: create and connect to server socket with port 5577
Tue Jan 21 16:13:23 2025: done
Tue Jan 21 16:13:23 2025: start main communications
Tue Jan 21 16:13:23 2025: wait for command from server
Tue Jan 21 16:13:23 2025: done with message size 37
Tue Jan 21 16:13:23 2025: decode message as analysis
Tue Jan 21 16:13:23 2025: send results to server
Tue Jan 21 16:13:23 2025: done with code 0
Tue Jan 21 16:13:23 2025: wait for command from server
Tue Jan 21 16:13:23 2025: done with message size 116
Tue Jan 21 16:13:23 2025: decode message as analysis
Tue Jan 21 16:13:23 2025: send results to server
Tue Jan 21 16:13:23 2025: done with code 0
Tue Jan 21 16:13:23 2025: wait for command from server
Tue Jan 21 16:13:49 2025: done with message size 268
Tue Jan 21 16:13:49 2025: decode message as analysis
Tue Jan 21 16:13:51 2025: send results to server
Tue Jan 21 16:13:51 2025: done with code 0
Tue Jan 21 16:13:51 2025: wait for command from server
Tue Jan 21 16:14:31 2025: done with message size 84
Tue Jan 21 16:14:31 2025: decode message as analysis
Tue Jan 21 16:14:31 2025: send results to server
Tue Jan 21 16:14:31 2025: done with code 0
Tue Jan 21 16:14:31 2025: wait for command from server
Tue Jan 21 16:15:55 2025: done with message size 84
Tue Jan 21 16:15:55 2025: decode message as analysis
Tue Jan 21 16:15:55 2025: send results to server
Tue Jan 21 16:15:55 2025: done with code 0
Tue Jan 21 16:15:55 2025: wait for command from server
Tue Jan 21 16:30:23 2025: done with message size 84
Tue Jan 21 16:30:23 2025: decode message as analysis
Tue Jan 21 16:30:23 2025: send results to server
Tue Jan 21 16:30:23 2025: done with code 0
Tue Jan 21 16:30:23 2025: wait for command from server

3140
Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/Server_log.txt Normal file
View File

File diff suppressed because it is too large Load Diff

9347
Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/VisualDVM_log.txt Normal file
View File

File diff suppressed because it is too large Load Diff

397
Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/Visualizer_2_log.txt Normal file
View File

File diff suppressed because one or more lines are too long

23
Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p2/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

240
Downloads/bugreport_1737466258/test_routine_4/p2/contains31.for Normal file
View File

@@ -0,0 +1,240 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,1:1 )
!DVM$ SHADOW a( 1:1,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(inout) a
intent(in) nz,ny,nx
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) b,a
intent(in) nz,ny,nx
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

19
Downloads/bugreport_1737466258/test_routine_4/p2/sol.for Normal file
View File

@@ -0,0 +1,19 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) nz,ny,nx,kk,jj,ii
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) nz,ny,nx,kk,jj,ii
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

19
Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/Sapfor_log.txt Normal file
View File

@@ -0,0 +1,19 @@
Wed Nov 8 19:40:29 2023: create and connect to server socket with port 3031
Wed Nov 8 19:40:29 2023: done
Wed Nov 8 19:40:29 2023: start main communications
Wed Nov 8 19:40:29 2023: wait for command from server
Wed Nov 8 19:40:29 2023: done with message size 37
Wed Nov 8 19:40:29 2023: decode message as analysis
Wed Nov 8 19:40:29 2023: send results to server
Wed Nov 8 19:40:29 2023: done with code 0
Wed Nov 8 19:40:29 2023: wait for command from server
Wed Nov 8 19:40:29 2023: done with message size 119
Wed Nov 8 19:40:29 2023: decode message as analysis
Wed Nov 8 19:40:29 2023: send results to server
Wed Nov 8 19:40:29 2023: done with code 0
Wed Nov 8 19:40:29 2023: wait for command from server
Wed Nov 8 19:42:32 2023: done with message size 271
Wed Nov 8 19:42:32 2023: decode message as analysis
Wed Nov 8 19:42:33 2023: send results to server
Wed Nov 8 19:42:33 2023: done with code 0
Wed Nov 8 19:42:33 2023: wait for command from server

6016
Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/Server_log.txt Normal file
View File

File diff suppressed because it is too large Load Diff

1477
Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/VisualDVM_log.txt Normal file
View File

File diff suppressed because it is too large Load Diff

1522
Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/Visualizer_2_log.txt Normal file
View File

File diff suppressed because one or more lines are too long

3
Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/spf.proj Normal file
View File

@@ -0,0 +1,3 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p2/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p2/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p2/visualiser_data/options/sol.for.dep

12
Downloads/bugreport_1737466258/test_routine_4/p3/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

248
Downloads/bugreport_1737466258/test_routine_4/p3/contains31.for Normal file
View File

@@ -0,0 +1,248 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,*,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p3/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p3/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p4/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p4/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 0:0,0:0,1:1 )
!DVM$ SHADOW a( 0:0,0:0,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,*,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p4/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p4/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p5/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p5/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 0:0,1:1,0:0 )
!DVM$ SHADOW a( 0:0,1:1,0:0 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,BLOCK,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p5/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p5/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p6/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p6/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 0:0,1:1,1:1 )
!DVM$ SHADOW a( 0:0,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p6/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p6/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p7/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p7/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,0:0,0:0 )
!DVM$ SHADOW a( 1:1,0:0,0:0 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,*,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p7/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p7/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p8/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p8/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,0:0,1:1 )
!DVM$ SHADOW a( 1:1,0:0,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,*,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p8/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p8/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

12
Downloads/bugreport_1737466258/test_routine_4/p9/call.for Normal file
View File

@@ -0,0 +1,12 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

250
Downloads/bugreport_1737466258/test_routine_4/p9/contains31.for Normal file
View File

@@ -0,0 +1,250 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,0:0 )
!DVM$ SHADOW a( 1:1,1:1,0:0 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

20
Downloads/bugreport_1737466258/test_routine_4/p9/sol.for Normal file
View File

@@ -0,0 +1,20 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

23
Downloads/bugreport_1737466258/test_routine_4/p9/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

13
Downloads/bugreport_1737466258/test_routine_4/sol.for Normal file
View File

@@ -0,0 +1,13 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

15
Downloads/bugreport_1737466258/test_routine_4/v1/call.for Normal file
View File

@@ -0,0 +1,15 @@
! *** generated by SAPFOR with version 2343 and build date: May 19 2024 20:06:27
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
double precision function calculate (value)
implicit none
double precision :: value
calculate = value / 6
end

191
Downloads/bugreport_1737466258/test_routine_4/v1/contains31.for Normal file
View File

@@ -0,0 +1,191 @@
! *** generated by SAPFOR with version 2343 and build date: May 19 2024 20:06:27
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program contains1
implicit none
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
integer :: it,itmax,nx,ny,nz
real :: relax1
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
integer :: i,j,k,max
real :: abs
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
integer :: i,j,k
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
integer :: i,j,k,max
real :: abs
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
implicit none
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
implicit none
character(len=9) :: name
print *, name,' - ***error'
end

23
Downloads/bugreport_1737466258/test_routine_4/v1/sol.for Normal file
View File

@@ -0,0 +1,23 @@
! *** generated by SAPFOR with version 2343 and build date: May 19 2024 20:06:27
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
implicit none
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
double precision function val (ii, jj, kk, nx, ny, nz)
implicit none
integer :: ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

3
Downloads/bugreport_1737466258/test_routine_4/v1/visualiser_data/spf.proj Normal file
View File

@@ -0,0 +1,3 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v1/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v1/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v1/visualiser_data/options/sol.for.dep

15
Downloads/bugreport_1737466258/test_routine_4/v2/call.for Normal file
View File

@@ -0,0 +1,15 @@
! *** generated by SAPFOR with version 2348 and build date: May 25 2024 20:14:21
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
double precision function calculate (value)
implicit none
double precision :: value
calculate = value / 6
end

190
Downloads/bugreport_1737466258/test_routine_4/v2/contains31.for Normal file
View File

@@ -0,0 +1,190 @@
! *** generated by SAPFOR with version 2348 and build date: May 25 2024 20:14:21
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program contains1
implicit none
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
integer :: it,itmax,nx,ny,nz
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
integer :: i,j,k,max
real :: abs
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
integer :: i,j,k
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
integer :: i,j,k,max
real :: abs
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
implicit none
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
implicit none
character(len=9) :: name
print *, name,' - ***error'
end

23
Downloads/bugreport_1737466258/test_routine_4/v2/sol.for Normal file
View File

@@ -0,0 +1,23 @@
! *** generated by SAPFOR with version 2348 and build date: May 25 2024 20:14:21
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
implicit none
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
double precision function val (ii, jj, kk, nx, ny, nz)
implicit none
integer :: ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

3
Downloads/bugreport_1737466258/test_routine_4/v2/visualiser_data/spf.proj Normal file
View File

@@ -0,0 +1,3 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v2/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v2/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v2/visualiser_data/options/sol.for.dep

23
Downloads/bugreport_1737466258/test_routine_4/visualiser_data/properties Normal file
View File

@@ -0,0 +1,23 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

3
Downloads/bugreport_1737466258/test_routine_4/visualiser_data/spf.proj Normal file
View File

@@ -0,0 +1,3 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/visualiser_data/options/sol.for.dep