      PROGRAM AS
C     ===========================================================
C     assertions on the mapping of the actual argument
C     ==========================================================
C     please send comments to haupt@npac.syr.edu

      PARAMETER(NDIM=512,MDIM=512)     
      REAL, DIMENSION(NDIM,MDIM) :: A
CHPF$ PROCESSORS P(4,2)
CHPF$ DISTRIBUTE A(BLOCK,BLOCK) ONTO P
      INTERFACE
        SUBROUTINE SUBA(X,N,M)
        REAL, DIMENSION(:,:) :: X
        INTEGER, INTENT(IN) :: N,M
CHPF$ PROCESSORS Q(4,2)
CHPF$ DISTRIBUTE X *(BLOCK,BLOCK) ONTO *Q
        END SUBROUTINE SUBA
      END INTERFACE      
      DATA NIT /5/

C     start_timer
C      call pcrc_clock(0)

      FORALL(I=2:NDIM-1,J=1:MDIM) A(I,J)=100
      FORALL(J=1:MDIM) A(1,J) = 0
      FORALL(J=1:MDIM) A(NDIM,J) = 0

      DO I=1,NIT
       CALL SUBA(A,NDIM,MDIM)
      ENDDO     

C      stop_timer
C      call pcrc_clock(1)

      print *,' ' 
      print *,'*******************************'
      print *,'         PARKBENCH '
      print *,' LOW LEVEL HPF BENCHMARK SUITE'
      print *,'         AS  KERNEL'
      print *,' PROBLEM SIZE: N, M =', NDIM,MDIM
      print *,  NIT,' ITERATIONS'
      print *,' FINAL RESULT = ', A(NDIM-2,2)
      print *,' EXPECTED VALUE FOR SIZE 512 BY 512' 
      print *,' AFTER 5 ITERATIONS'
      print *,' IS  85.547 +/- 0.001'
      print *,'*******************************'

C     print execution time

      STOP
      END

      SUBROUTINE SUBA(X,N,M)
      REAL, DIMENSION(:,:) :: X
        INTEGER, INTENT(IN) :: N,M
CHPF$ PROCESSORS Q(4,2)
CHPF$ DISTRIBUTE X *(BLOCK,BLOCK) ONTO *Q
C     =============================================================
C     Array X is asserted to already be distributed (BLOCK,BLOCK)
C     onto Q so, if possible, no data movement should occur
C     =============================================================
      
      FORALL (I=2:N-1,J=2:M-1) X(I,J)=0.25*(X(I+1,J)+X(I-1,J)+
     &        X(I,J-1)+X(I,J+1))

      RETURN
      END




