C     *****************
      SUBROUTINE STAPLE(
C     *****************
     >                  NVH,NVL,NVE,ICC,I,
     >                  SHT,GCB,LINKS,
     >                  WK1,WK2,WK3,WK4 )
C
C
      DOUBLE PRECISION  LINKS(NVE,18,4),
     >                  WK1(NVH,18),WK2(NVH,18),WK3(NVH,18),WK4(NVH,18),
     >                  ZERO,RTIME,TSTART,TEND
C
C
      COMMON / PERF / RTIME(15),IPRO
C
C
      INTEGER    GCB(NVH,2)
C
      INTEGER    SHT(4)
C
C
      PARAMETER( ZERO = 0.D0 )
C
C
C     INITIALIZE PLAQUETTE SUM TO ZERO
C
C
      DO 10 ISM = 1,18
      DO 10 IVL = 1,NVL
      WK4(IVL,ISM) = ZERO
   10 CONTINUE
C
C
      DO 20 J = 1,4
C
C
      IF( J .EQ. I ) GOTO 20
C
C
C     ***********
      CALL GATHER( NVH,NVL,WK1,NVE,LINKS(1,1,J),GCB(1,ICC),SHT(I) )
C     ***********
C
C
C     ***********
      CALL GATHER( NVH,NVL,WK2,NVE,LINKS(1,1,I),GCB(1,ICC),SHT(J) )
C     ***********
C
      CALL TIMER(TSTART)
C     ********
      CALL PRO(NVH,NVL,2,WK3,WK1,WK2)
C     ********
      CALL TIMER(TEND)
      RTIME(8) = RTIME(8) + TEND - TSTART
C
C
C     ***********
      CALL GATHER( NVH,NVL,WK2,NVE,LINKS(1,1,J),GCB(1,ICC),0 )
C     ***********
C
      CALL TIMER(TSTART)
C     ********
      CALL PRO(NVH,NVL,2,WK1,WK3,WK2)
C     ********
      CALL TIMER(TEND)
      RTIME(8) = RTIME(8) + TEND - TSTART
C
C
      DO 30 ISM = 1,18
      DO 30 IVL = 1,NVL
      WK4(IVL,ISM) = WK4(IVL,ISM) + WK1(IVL,ISM)
   30 CONTINUE
C
C
C     ***********
      CALL GATHER(NVH,NVL,WK1,NVE,LINKS(1,1,J),GCB(1,ICC),SHT(I)-SHT(J))
C     ***********
C
C
C     ***********
      CALL GATHER( NVH,NVL,WK2,NVE,LINKS(1,1,I),GCB(1,ICC),-SHT(J) )
C     ***********
C
C
      CALL TIMER(TSTART)
C     ********
      CALL PRO(NVH,NVL,3,WK3,WK1,WK2)
C     ********
      CALL TIMER(TEND)
      RTIME(8) = RTIME(8) + TEND - TSTART
C
C
C     ***********
      CALL GATHER( NVH,NVL,WK2,NVE,LINKS(1,1,J),GCB(1,ICC),-SHT(J) )
C     ***********
C
C
      CALL TIMER(TSTART)
C     ********
      CALL PRO(NVH,NVL,1,WK1,WK3,WK2)
C     ********
      CALL TIMER(TEND)
      RTIME(8) = RTIME(8) + TEND - TSTART
C
C
      DO 40 ISM = 1,18
      DO 40 IVL = 1,NVL
      WK4(IVL,ISM) = WK4(IVL,ISM) + WK1(IVL,ISM)
   40 CONTINUE
C
C
   20 CONTINUE
C
C
      END
