      PROGRAM TM
C     =================================================================
C     template kerenel
C     adopted from the Purdue Set  (J. Rice)
C     =================================================================
C     please send comments to haupt@npac.syr.edu

      INTEGER NDIM,MDIM,ND1,MD1
      PARAMETER (NDIM=1023,MDIM=2047,ND1=NDIM+1,MD1=MDIM+1)
      REAL, DIMENSION(MDIM)          :: R
      REAL, DIMENSION(NDIM)          :: C
      REAL, DIMENSION(NDIM,MDIM)     :: A
      REAL, DIMENSION(ND1,MD1)       :: ABIG
      REAL, DIMENSION(1,1)           :: ACORN
      REAL, DIMENSION(NDIM-1,MDIM-1) :: B
      LOGICAL DEBUG
      DATA DEBUG /.FALSE./
c      DATA DEBUG /.TRUE./

CHPF$ PROCESSORS P(8)
CHPF$ TEMPLATE TMPL(ND1)
CHPF$ DISTRIBUTE TMPL(BLOCK) onto P
CHPF$ ALIGN ABIG(i,*) with TMPL(i)
CHPF$ ALIGN A(i,*) with TMPL(i)
CHPF$ ALIGN C(:) with TMPL(:)
CHPF$ ALIGN B(i,*) with TMPL(i+2) 

c      start_timer
C      call pcrc_clock(0)

      do it=1,3 
      forall(i=1:mdim) r(i)=1.0+i
      forall(i=1:ndim) c(i)=1.0-i
      forall(i=1:ndim,j=1:mdim) a(i,j)=i+j
      acorn = 0.5

      ABIG(1:NDIM,1:MDIM)=A
      ABIG(1:NDIM,MD1)=C
      ABIG(ND1,1:MDIM)=R
      ABIG(ND1,MD1)=ACORN(1,1)


      FORALL(I=1:ND1-2,J=1:MD1-2) B(I,J)=ABIG(I+2,J+2)

      enddo
c      stop_timer()
C      call pcrc_clock(1)

      print *,' ' 
      print *,'*******************************'
      print *,'         PARKBENCH '
      print *,' LOW LEVEL HPF BENCHMARK SUITE'
      print *,'         TM  KERNEL'
      print *,' PROBLEM SIZE: N, M =',ND1,MD1
      print *,' FINAL RESULT = ',B(ndim-2,mdim-2)
      print *,' EXPECTED VALUE FOR', ND1,' by',MD1
      print *,'      is', ndim+mdim
      print *,'*******************************'

c     print execution time

      IF(DEBUG) THEN
        write(6,*) abig(nd1,md1),' and should be', acorn(1,1)
        write(6,*) abig(ndim,mdim),' and should be', ndim+mdim
        write(6,*) abig(ndim,md1),' and should be',1-ndim 
        write(6,*) abig(nd1,mdim),' and should be',1+mdim
        write(6,*) b(ndim-1,mdim-1),' and should be', acorn(1,1)
      ENDIF

      STOP
      END





