! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43 ! *** Enabled options ***: ! *** shadow optimization ! *** save SPF directives ! *** maximum shadow width is 100 percent ! *** generated by SAPFOR program acrred21 !DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:16,1:16) !DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp0 !DVM$ DYNAMIC dvmh_temp0 !DVM$ TEMPLATE,COMMON:: dvmh_temp1(1:16,1:16) !DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp1 !DVM$ DYNAMIC dvmh_temp1 !DVM$ TEMPLATE,COMMON:: dvmh_temp2(1:16,1:16) !DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp2 !DVM$ DYNAMIC dvmh_temp2 !DVM$ TEMPLATE,COMMON:: dvmh_temp3(1:16,1:16) !DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp3 !DVM$ DYNAMIC dvmh_temp3 !DVM$ TEMPLATE,COMMON:: dvmh_temp4(1:16,1:16) !DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp4 !DVM$ DYNAMIC dvmh_temp4 ! 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)) !DVM$ TEMPLATE, COMMON :: dvmh_temp4(1:16,1:16) !DVM$ DISTRIBUTE dvmh_temp4(BLOCK,BLOCK) !DVM$ DYNAMIC dvmh_temp4 !DVM$ ALIGN :: a !DVM$ DYNAMIC a integer ,allocatable:: a(:,:),c(:,:) !DVM$ SHADOW a( 1:1,1:1 ) integer :: nloopi,nloopj,isumc,isuma intrinsic min ! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A tname = 'acrred2101' allocate(a(n,m),c(n,m)) !DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp4(iEX1,iEX2) continue 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 !DVM$ ACTUAL (c) !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j) do j = 1,m do i = 1,n a(i,j) = nl + i + j enddo enddo !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:1,1:1)),REDUCT !DVM$&ION (min (nloopi),min (nloopj),sum (isuma)) 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 !DVM$ END REGION 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)) !DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:16,1:16) !DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK) !DVM$ DYNAMIC dvmh_temp0 !DVM$ ALIGN :: a !DVM$ DYNAMIC a integer ,allocatable:: a(:,:),c(:,:) !DVM$ SHADOW a( 0:1,0:0 ) integer :: nloopi,nloopj,iproda,iprodc intrinsic min tname = 'acrred2102' allocate(a(n,m),c(n,m)) !DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp0(iEX1,iEX2) continue 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 !DVM$ ACTUAL (c) nloopi = nl nloopj = nl !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j) do j = 1,m do i = 1,n a(i,j) = nl + i + j enddo enddo !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(0:1,0:0)),REDUCT !DVM$&ION (min (nloopi),min (nloopj),product (iproda)) 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 !DVM$ END REGION 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)) !DVM$ TEMPLATE, COMMON :: dvmh_temp1(1:16,1:16) !DVM$ DISTRIBUTE dvmh_temp1(BLOCK,BLOCK) !DVM$ DYNAMIC dvmh_temp1 !DVM$ ALIGN :: a !DVM$ DYNAMIC a integer ,allocatable:: a(:,:),c(:,:) !DVM$ SHADOW a( 1:0,0:1 ) integer :: imaxc,imaxa intrinsic max ! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A tname = 'acrred2103' allocate(a(n,m),c(n,m)) !DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp1(iEX1,iEX2) continue 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 !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j) do j = 1,m do i = 1,n a(i,j) = nl + i + j enddo enddo !DVM$ END REGION !DVM$ GET_ACTUAL (a) !DVM$ REMOTE_ACCESS (a(1,1)) imaxa = a(1,1) !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:0,0:1)),REDUCT !DVM$&ION (max (imaxa)) 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 !DVM$ END REGION 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)) !DVM$ TEMPLATE, COMMON :: dvmh_temp2(1:16,1:16) !DVM$ DISTRIBUTE dvmh_temp2(BLOCK,BLOCK) !DVM$ DYNAMIC dvmh_temp2 !DVM$ ALIGN :: a !DVM$ DYNAMIC a integer ,allocatable:: a(:,:),c(:,:) !DVM$ SHADOW a( 1:0,0:1 ) integer :: iminc,imina intrinsic min tname = 'acrred2103' allocate(a(n,m),c(n,m)) !DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp2(iEX1,iEX2) continue 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 !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j) do j = 1,m do i = 1,n a(i,j) = nl + i + j enddo enddo !DVM$ END REGION !DVM$ GET_ACTUAL (a) !DVM$ REMOTE_ACCESS (a(1,1)) imina = a(1,1) !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:0,0:1)),REDUCT !DVM$&ION (min (imina)) 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 !DVM$ END REGION 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)) !DVM$ TEMPLATE, COMMON :: dvmh_temp3(1:16,1:16) !DVM$ DISTRIBUTE dvmh_temp3(BLOCK,BLOCK) !DVM$ DYNAMIC dvmh_temp3 !DVM$ ALIGN :: a !DVM$ DYNAMIC a integer ,allocatable:: a(:,:),c(:,:) !DVM$ SHADOW a( 0:1,1:0 ) 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)) !DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp3(iEX1,iEX2) continue 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) !DVM$ REGION !DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j) do j = 1,m do i = 1,n a(i,j) = nl + i + j enddo enddo !DVM$ END REGION !DVM$ GET_ACTUAL (a) !DVM$ REMOTE_ACCESS (a(1,1)) ! 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 !DVM$ REGION !DVM$ PARALLEL (i,j) ON a(i,j), PRIVATE (i,j),ACROSS (a(0:1,1:0)),REDUCT !DVM$&ION (maxloc (imaxa,coora,2)) !$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$ END REGION ! 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