
      SUBROUTINE INITSH
C     --------------------
C     ---------------------------------------------------
C     |    Set up address arrays for vector shifts.     |
C     ---------------------------------------------------
      INCLUDE 'qcd2.inc'

      INTEGER     XSIZE,  YSIZE,  ZSIZE
      PARAMETER ( XSIZE  =  SEGT * SEGY * SEGZ * NCOLOR,
     *            YSIZE  =  SEGT * SEGX * SEGZ * NCOLOR,
     *            ZSIZE  =  SEGT * SEGX * SEGY * NCOLOR )

      INTEGER  POST (VSIZE, 0:1),  NEGT (VSIZE, 0:1), 
     *         POSX (VSIZE),      NEGX (VSIZE),
     *         POSY (VSIZE),      NEGY (VSIZE),
     *         POSZ (VSIZE),      NEGZ (VSIZE)
      COMMON / ISHIFT / POST, POSX, POSY, POSZ, NEGT, NEGX, NEGY, NEGZ 

      INTEGER  BEGX( XSIZE), ENDX( XSIZE), BEGY( YSIZE), ENDY( YSIZE),
     *         BEGZ( ZSIZE), ENDZ( ZSIZE)
      COMMON / ENDS / BEGX, ENDX, BEGY, ENDY, BEGZ, ENDZ

      INTEGER  I, T, X, Y, Z, PAR, NDEST, PDEST, SOURCE, NFINAL
      PARAMETER ( NFINAL = NCMPLX * NCOLOR )

      INTEGER  DUMMY, COUNT
      INTEGER  FLAT, PARITY

      PARITY (T,X,Y,Z) = MOD (T + X + Y + Z, 2)
      FLAT (T,X,Y,Z,I) = (T+1)/2 + (SEGT/2) * ((X-1) + SEGX * 
     *                   ((Y-1) + SEGY * ((Z-1) + SEGZ * (I-1)))) 

      DO 1000 I = 1, NFINAL
C     ---------------
C     |   t shifts  |
C     ---------------
                DO 80  Z = 1, SEGZ
                  DO 70  Y = 1, SEGY
                    DO 60  X = 1, SEGX

                      PAR    =  PARITY (1, X, Y, Z)
                      SOURCE =    FLAT (1, X, Y, Z,I)
                      PDEST   =    FLAT ( 2, X, Y, Z,I)
                      POST (SOURCE, PAR) = PDEST
                      NDEST   =    FLAT ( SEGT, X, Y, Z,I)
                      NEGT (SOURCE, PAR) = NDEST

                      DO 50  T = 2, (SEGT-1)
                        SOURCE =    FLAT (T, X, Y, Z,I)
                        PDEST   =    FLAT ((T+1), X, Y, Z,I)
                        PAR    =  PARITY (T, X, Y, Z) 
                        POST (SOURCE, PAR) = PDEST
                        NDEST   =    FLAT ((T-1), X, Y, Z,I)
                        NEGT (SOURCE, PAR) = NDEST
 50                   CONTINUE

                      PAR    =  PARITY (SEGT, X, Y, Z)
                      SOURCE =    FLAT (SEGT, X, Y, Z,I)
                      PDEST   =    FLAT ( 1, X, Y, Z,I)
                      POST (SOURCE, PAR) = PDEST
                      NDEST   =    FLAT ( (SEGT-1), X, Y, Z,I)
                      NEGT (SOURCE, PAR) = NDEST

 60                 CONTINUE
 70               CONTINUE
 80             CONTINUE

C     ---------------
C     |   x shifts  |
C     ---------------
C  Following line is inserted to workround compile bug
                DUMMY = 0

                DO 180  Z = 1, SEGZ
                  DO 170  Y = 1, SEGY
                    DO 160  T = 1, (SEGT-1), 2

                      COUNT = (T+1)/2 + SEGT/2 * ( (Y-1) + SEGY * 
     *                        ( (Z-1) + SEGZ * (I-1) ))
                      SOURCE =  FLAT (T, 1, Y, Z,I)
                      BEGX( COUNT) = SOURCE
                      PDEST   =  FLAT (T, 2, Y, Z,I)
                      POSX (SOURCE) = PDEST
                      NDEST   =  FLAT (T, SEGX, Y, Z,I)
                      NEGX (SOURCE) = NDEST

                      DO 150  X = 2, (SEGX-1)
                        SOURCE =  FLAT (T, X, Y, Z,I)
                        PDEST   =  FLAT (T, (X+1), Y, Z,I)
                        POSX (SOURCE) = PDEST
                        NDEST   =  FLAT (T, (X-1), Y, Z,I)
                        NEGX (SOURCE) = NDEST
 150                  CONTINUE

                      SOURCE =  FLAT (T, SEGX, Y, Z,I)
                      ENDX( COUNT) = SOURCE
                      PDEST   =  FLAT (T, 1, Y, Z,I)
                      POSX (SOURCE) = PDEST
                      NDEST   =  FLAT (T, (SEGX-1), Y, Z,I)
                      NEGX (SOURCE) = NDEST

 160                CONTINUE
 170              CONTINUE
 180            CONTINUE

C     ---------------
C     |   y shifts  |
C     ---------------
C  Following line is inserted to workround compile bug
                DUMMY = 0

                DO 280  Z = 1, SEGZ
                  DO 270  X = 1, SEGX
                    DO 260  T = 1, (SEGT-1), 2

                      COUNT = (T+1)/2 + SEGT/2 * ( (X-1) + SEGX * 
     *                        ( (Z-1) + SEGZ * (I-1) ))
                      SOURCE =  FLAT (T, X, 1, Z,I)
                      BEGY( COUNT) = SOURCE
                      PDEST   =  FLAT (T, X, 2, Z,I)
                      POSY (SOURCE) = PDEST
                      NDEST   =  FLAT (T, X, SEGY, Z, I)
                      NEGY (SOURCE) = NDEST

                      DO 250  Y = 2, (SEGY-1)
                        SOURCE =  FLAT (T, X, Y, Z,I)
                        PDEST   =  FLAT (T ,X, (Y+1), Z,I)
                        POSY (SOURCE) = PDEST
                        NDEST   =  FLAT (T ,X, (Y-1), Z,I)
                        NEGY (SOURCE) = NDEST
 250                  CONTINUE

                      SOURCE =  FLAT (T, X, SEGY, Z,I)
                      ENDY( COUNT) = SOURCE
                      PDEST   =  FLAT (T, X, 1, Z,I)
                      POSY (SOURCE) = PDEST
                      NDEST   =  FLAT (T, X, (SEGY-1), Z,I)
                      NEGY (SOURCE) = NDEST


 260                CONTINUE
 270              CONTINUE
 280            CONTINUE

C     ---------------
C     |   z shifts  |
C     ---------------
C  Following line is inserted to workround compile bug
                DUMMY = 0

                DO 380  Y = 1, SEGY
                  DO 370  X = 1, SEGX
                    DO 360  T = 1, (SEGT-1), 2

                      COUNT = (T+1)/2 + SEGT/2 * ( (X-1) + SEGX * 
     *                        ( (Y-1) + SEGY * (I-1) ))
                      SOURCE =  FLAT (T, X, Y, 1,I)
                      BEGZ( COUNT) = SOURCE
                      PDEST   =  FLAT (T, X, Y, 2,I )
                      POSZ (SOURCE) = PDEST
                      NDEST   =  FLAT (T, X, Y, SEGZ, I )
                      NEGZ (SOURCE) = NDEST

                      DO 350  Z = 2, (SEGZ-1)
                        SOURCE =  FLAT (T, X, Y, Z,I)
                        PDEST   =  FLAT (T, X, Y, (Z+1),I) 
                        POSZ (SOURCE) = PDEST
                        NDEST   =  FLAT (T, X, Y, (Z-1),I) 
                        NEGZ (SOURCE) = NDEST
 350                  CONTINUE

                      SOURCE =  FLAT (T, X, Y, SEGZ,I)
                      ENDZ( COUNT) = SOURCE
                      PDEST   =  FLAT (T, X, Y, 1,I )
                      POSZ (SOURCE) = PDEST
                      NDEST   =  FLAT (T, X, Y, (SEGZ-1),I )
                      NEGZ (SOURCE) = NDEST

 360                CONTINUE
 370              CONTINUE
 380            CONTINUE

 1000 CONTINUE

      END
