Files
VisualSapfor/Downloads/bugreport_1733152707/acrred21/m1/acrred21.for

920 lines
24 KiB
Plaintext
Raw Normal View History

! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end