      PROGRAM ADD
      PARAMETER (nproc0 = 2)
      PARAMETER (nproc1 = 4)
      PARAMETER (N = 4)
      PARAMETER (NN = 4)
      INTEGER A (2, 1), B (2, 1)
C     DECOMPOSITION d (4, 4)
C     DISTRIBUTE d (BLOCK, BLOCK)
C     ALIGN A (i, j) WITH d (i, j)
C     ALIGN B (i, j) WITH d (i, j)
      INTEGER Tllb1, Tllb2
      INTEGER Tlub1, Tlub2
      INTEGER minLoc1, maxLoc1, minLoc2, maxLoc2, coord(3)
      COMMON /g_to_l/minLoc1, maxLoc1, minLoc2, maxLoc2, coord
      INTEGER proclist(8)
      INTEGER TT0temp
      INTEGER TT1temp
      INTEGER TT2temp
      INTEGER TT3temp (2)
      INTEGER TT4temp (2)
      INTEGER TT5temp (2)
      INTEGER TT6temp
      INTEGER TT7temp (2)
      INTEGER TT8temp (2)
      INTEGER TT9temp
      INTEGER TT10temp (2)
      INTEGER TT11temp (2)
      INTEGER TT12temp
      INTEGER TT13temp (2)
      INTEGER TT14temp (2)
      CALL EXP_init_2 (2, 4, 2, 1)
      proclist(1)=-1
      TT0temp = 1
      DO j = 1, 1
      DO i = 1, 2
      A (i, j) = 1
      END DO
      END DO
      TT0temp = 1
      DO j = 1, 1
      DO i = 1, 2
      B (i, j) = 8
      END DO
      END DO
      CALL adjust_local_bounds (2, N - 1, Tllb1, Tlub1, 1, 2)
      CALL adjust_local_bounds (2, NN - 1, Tllb2, Tlub2, 2, 1)
      TT0temp = 1
      TT2temp = 1
      DO j = Tllb2, Tlub2
      DO i = Tllb1, Tlub1
      TT3temp (1) = ((i + minLoc1 - 1) - 1) / 2
      TT3temp (2) = ((j + minLoc2 - 1) - 1 - 1) / 1
      TT4temp (TT2temp) = KXGDPR (TT3temp)
      TT5temp (TT2temp) = ((i + minLoc1 - 1) - (2 * TT3temp (1))) + (((j
     & + minLoc2 - 1) - 1 - (1 * TT3temp (2)) - 1) * 2)
      TT2temp = TT2temp + 1
      
      END DO
      END DO
      TT2temp = TT2temp - 1
      TT1temp = IFSCHEDULE (TT5temp, TT4temp, TT2temp)
      
      CALL IFGATHER (TT1temp, TT5temp, A)
      
      TT6temp = 1
      DO j = Tllb2, Tlub2
      DO i = Tllb1, Tlub1
      TT4temp (1) = ((i + minLoc1 - 1) - 1) / 2
      TT4temp (2) = ((j + minLoc2 - 1) + 1 - 1) / 1
      TT7temp (TT6temp) = KXGDPR (TT4temp)
      TT8temp (TT6temp) = ((i + minLoc1 - 1) - (2 * TT4temp (1))) + (((j
     & + minLoc2 - 1) + 1 - (1 * TT4temp (2)) - 1) * 2)
      TT6temp = TT6temp + 1
      
      END DO
      END DO
      TT6temp = TT6temp - 1
      TT2temp = IFSCHEDULE (TT8temp, TT7temp, TT6temp)
      
      CALL IFGATHER (TT2temp, TT8temp, A)
      
      TT9temp = 1
      DO j = Tllb2, Tlub2
      DO i = Tllb1, Tlub1
      TT7temp (1) = ((i + minLoc1 - 1) - 1 - 1) / 2
      TT7temp (2) = ((j + minLoc2 - 1) - 1) / 1
      TT10temp (TT9temp) = KXGDPR (TT7temp)
      TT11temp (TT9temp) = ((i + minLoc1 - 1) - 1 - (2 * TT7temp (1))) +
     & (((j + minLoc2 - 1) - (1 * TT7temp (2)) - 1) * 2)
      TT9temp = TT9temp + 1
      
      END DO
      END DO
      TT9temp = TT9temp - 1
      TT6temp = IFSCHEDULE (TT11temp, TT10temp, TT9temp)
      
      CALL IFGATHER (TT6temp, TT11temp, A)
      
      TT12temp = 1
      DO j = Tllb2, Tlub2
      DO i = Tllb1, Tlub1
      TT10temp (1) = ((i + minLoc1 - 1) + 1 - 1) / 2
      TT10temp (2) = ((j + minLoc2 - 1) - 1) / 1
      TT13temp (TT12temp) = KXGDPR (TT10temp)
      TT14temp (TT12temp) = ((i + minLoc1 - 1) + 1 - (2 * TT10temp (1)))
     & + (((j + minLoc2 - 1) - (1 * TT10temp (2)) - 1) * 2)
      TT12temp = TT12temp + 1
      
      END DO
      END DO
      TT12temp = TT12temp - 1
      TT9temp = IFSCHEDULE (TT14temp, TT13temp, TT12temp)
      
      CALL IFGATHER (TT9temp, TT14temp, A)
      
      DO j = Tllb2, Tlub2
      DO i = Tllb1, Tlub1
      B (i, j) = TT5temp (TT0temp) + TT8temp (TT0temp) + TT11temp (TT0te
     &mp) + TT14temp (TT0temp)
      TT0temp = TT0temp + 1
      END DO
      END DO
      DO 7002 i = 1, N / nproc0
      DO 7000 j = 1, NN / nproc1
      CALL kmulti (6)
      WRITE (6, *) 'I=', i + minLoc1 - 1, 'J=', j + minLoc2 - 1, B (i, j
     &)
      CALL kflush (6)
7000  CONTINUE
7002  CONTINUE
      END
