C     *****************
      SUBROUTINE SUREXC(
C     *****************
     >                  NXYZH,NXYTH,NXZTH,NYZTH,
     >                  NXYH,NXZH,NXTH,NYZH,NYTH,NZTH,
     >                  ICC,ILD,
     >                  LINKS,WK1,NVE,NVH,
     >                  GX,GY,GZ,GT,
     >                  GXY,GXZ,GXT,GYZ,GYT,GZT,
     >                  LX,LY,LZ,LT,
     >                  LXY,LXZ,LXT,LYZ,LYT,LZT)
C
C
C     SUBROUTINE  SUREXC EXCHANGES THE SURFACES OF THE FOUR DIMENSIONAL
C     LATTICE AND PROVIDES PERIODIC BOUNDARY CONDITIONS
C
C
C     LATEST REVISION - NOV. 1989; E.KEHL
C
C
      DOUBLE PRECISION LINKS(NVE,18,4),
     >                 WK1(NVH,18)
C
C
      INTEGER          GX(NYZTH,2,4),GY(NXZTH,2,4),
     >                 GZ(NXYTH,2,4),GT(NXYZH,2,4)
C
      INTEGER          GXY(NZTH,2,4),GXZ(NYTH,2,4),
     >                 GXT(NYZH,2,4),GYZ(NXTH,2,4),
     >                 GYT(NXZH,2,4),GZT(NXYH,2,4)
C
      INTEGER          LX(2,4),LY(2,4),
     >                 LZ(2,4),LT(2,4)
C
      INTEGER          LXY(2,4),LXZ(2,4),
     >                 LXT(2,4),LYZ(2,4),
     >                 LYT(2,4),LZT(2,4)
C
C
C     EXCHANGE OF X-LINKS
C
C
      IF( ILD .EQ. 1 ) THEN
C
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,1,3, LX, WK1,ICC,ILD )
CNOT     CALL SRLKS(
CNOT >        LINKS,NVE, GX,NYZTH,2,4, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,1,3, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,2,4, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,1,3, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,2,4, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,1,3, LT, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,2,4, LT, WK1,ICC,ILD )
C
         CALL SRLKS(
     >        LINKS,NVE,GXY, NZTH,1,3,LXY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GXZ, NYTH,1,3,LXZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GXT, NYZH,1,3,LXT, WK1,ICC,ILD )
C
      ENDIF
C
C
C     EXCHANGE OF Y-LINKS
C
C
      IF( ILD .EQ. 2 ) THEN
C
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,1,3, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,2,4, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,1,3, LY, WK1,ICC,ILD )
CNOT     CALL SRLKS(
CNOT >        LINKS,NVE, GY,NXZTH,2,4, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,1,3, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,2,4, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,1,3, LT, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,2,4, LT, WK1,ICC,ILD )
C
         CALL SRLKS(
     >        LINKS,NVE,GXY, NZTH,2,4,LXY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GYZ, NXTH,1,3,LYZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GYT, NXZH,1,3,LYT, WK1,ICC,ILD )
C
      ENDIF
C
C
C     EXCHANGE OF Z-LINKS
C
C
      IF( ILD .EQ. 3 ) THEN
C
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,1,3, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,2,4, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,1,3, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,2,4, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,1,3, LZ, WK1,ICC,ILD )
CNOT     CALL SRLKS(
CNOT >        LINKS,NVE, GZ,NXYTH,2,4, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,1,3, LT, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,2,4, LT, WK1,ICC,ILD )
C
         CALL SRLKS(
     >        LINKS,NVE,GXZ, NYTH,2,4,LXZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GYZ, NXTH,2,4,LYZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GZT, NXYH,1,3,LZT, WK1,ICC,ILD )
C
      ENDIF
C
C
C     EXCHANGE OF T-LINKS
C
C
      IF( ILD .EQ. 4 ) THEN
C
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,1,3, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GX,NYZTH,2,4, LX, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,1,3, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GY,NXZTH,2,4, LY, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,1,3, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GZ,NXYTH,2,4, LZ, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE, GT,NXYZH,1,3, LT, WK1,ICC,ILD )
CNOT     CALL SRLKS(
CNOT >        LINKS,NVE, GT,NXYZH,2,4, LT, WK1,ICC,ILD )
C
         CALL SRLKS(
     >        LINKS,NVE,GXT, NYZH,2,4,LXT, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GYT, NXZH,2,4,LYT, WK1,ICC,ILD )
         CALL SRLKS(
     >        LINKS,NVE,GZT, NXYH,2,4,LZT, WK1,ICC,ILD )
C
      ENDIF
C
C
      RETURN
      END
