CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C     THIS FILE CONTAINS THE SOURCE CODE FOR FORTRAN 90D INTRINSIC   C
C     FUNCTIONS.                                                     C
C                                                                    C
C     VERSION 1.00, 10/11/92                                         C
C                                                                    C
C     COPYRIGHT (C) NORTHEAST PARALLEL ARCHITECTURES CENTER,         C
C     SYRACUSE UNIVERSITY, SYRACUSE, NY 13244, USA.                  C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C routine for eoshift operation 1D
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_1_I(ARRAY, a1, a2, ARRAY_INFO, SHIFT, 
     &     RESULT, r1, r2, RESULT_INFO, PROCLIST)
      
      integer a1, a2, r1, r2, ARRAY_INFO(8,7), RESULT_INFO(8,7)
      integer ARRAY(a1:a2), RESULT(r1:r2)
      integer SHIFT, PROCLIST(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), nproc(2)
      integer intSize, realSize
      data realSize, intSize/4, 4/
      integer lb, ub, size, i
      integer type, status, in
      integer sp1, sp2, dp1, dp2, L1, L2, U1, U2, loc_shift
      integer pe1, pe2, len1, len2
      integer coord1(2), coord2(2)
      integer bound, dest, src
      
      nproc(1) = ARRAY_INFO(8,1)
      status = KXGDIN(1, nproc)
      status = KXPARA(ENV)
      bound = 0
      lb   = ARRAY_INFO(1,1)
      ub   = ARRAY_INFO(2,1)
      size = ub - lb + 1
      status = KXGDCO(ENV(1), coord1)

      SHIFT = -SHIFT
      if (SHIFT .LT. 0) then
         loc_shift = -SHIFT
         pe1 = (lb - 1 + loc_shift)/size
         dp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = MOD(loc_shift, size) + 1
            U1 = size
            len1 = U1-L1+1
            type = 255+dp1
            dest = dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dest, type)
         end if
         
         pe2 = (ub - 1 + loc_shift)/size
         dp2 = KXGDNO(ENV(1), 0, -pe2)
         L2 = lb
         U2 = MOD(loc_shift -1, size)+1
         len2 = U2-L2+1
         dest = dp2
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dest, type)
         end if
         
      else if (SHIFT .GT. 0) then
         pe1 = (lb- 1 + SHIFT)/size
         dp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = lb
            U1 = MOD(ENV(2)*size -1 - SHIFT, size) +1 
            len1 = U1-L1+1
            type = 255+dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dp1, type)
         end if
         
         pe2 = (ub- 1 + SHIFT)/size
         dp2 = KXGDNO(ENV(1), 0, pe2)
         L2 = MOD(ENV(2)*size - SHIFT, size)+1
         U2 = size
         len2 = U2-L2+1
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dp2, type)
         end if
         
      end if

CC receiving side

      if (SHIFT .LT. 0) then
         in = lb
         loc_shift = - SHIFT
         if (loc_shift .LT. size) then
            do i = lb+loc_shift, ub
               RESULT(i-loc_shift) = ARRAY(i)
               in = in + 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (sp1 .NE. ENV(1)) then
            type = 255+ENV(1)
            status = KXREAD(RESULT(in),len1*intSize,sp1, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = bound
               end do
            end if
            in = in + len1
         end if
         
         sp2 = KXGDNO(ENV(1), 0, pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            type = 355+ENV(1)
            status = KXREAD(RESULT(in), len2*intSize, sp2, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
      else if (SHIFT .GT. 0) then
         in = lb
         if (SHIFT .LT. size) then
            in = ub
            do i = ub-SHIFT, lb, - 1
               RESULT(i+SHIFT) = ARRAY(i)
               in = in - 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (sp1 .NE. ENV(1)) then
            in = ub-len1+1
            type = 255+ENV(1)
            src = sp1
            status = KXREAD(RESULT(in),len1*intSize,src, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
         sp2 = KXGDNO(ENV(1), 0, -pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            in = lb
            type = 355+ENV(1)
            dest = sp2
            status = KXREAD(RESULT(in), len2*intSize, dest, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
         if ((sp2 .EQ. ENV(1)) .AND. (sp1 .EQ. ENV(1))) then
            do i = lb, lb+SHIFT
               RESULT(i) = bound
            end do
         end if
      end if
      
      return
      end 





CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine EOSHIFT_1_R(ARRAY, a1, a2, ARRAY_INFO, SHIFT, 
     &     RESULT, r1, r2, RESULT_INFO, PROCLIST)
      
      integer a1, a2, r1, r2, ARRAY_INFO(8,7), RESULT_INFO(8,7)
      real ARRAY(a1:a2), RESULT(r1:r2)
      integer SHIFT, PROCLIST(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      real bound
      integer ENV(4), nproc(2)
      integer intSize, realSize
      data realSize, intSize/4, 4/
      integer lb, ub, size, i
      integer type, status, in
      integer sp1, sp2, dp1, dp2, L1, L2, U1, U2, loc_shift
      integer pe1, pe2, len1, len2
      integer coord1(2), coord2(2)
      integer dest, src
      
      nproc(1) = ARRAY_INFO(8,1)
      status = KXGDIN(1, nproc)
      status = KXPARA(ENV)
      bound = 0.0
      lb   = ARRAY_INFO(1,1)
      ub   = ARRAY_INFO(2,1)
      size = ub - lb + 1
      status = KXGDCO(ENV(1), coord1)

      SHIFT = -SHIFT
      if (SHIFT .LT. 0) then
         loc_shift = -SHIFT
         pe1 = (lb - 1 + loc_shift)/size
         dp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = MOD(loc_shift, size) + 1
            U1 = size
            len1 = U1-L1+1
            type = 255+dp1
            dest = dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dest, type)
         end if
         
         pe2 = (ub - 1 + loc_shift)/size
         dp2 = KXGDNO(ENV(1), 0, -pe2)
         L2 = lb
         U2 = MOD(loc_shift -1, size)+1
         len2 = U2-L2+1
         dest = dp2
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dest, type)
         end if
         
      else if (SHIFT .GT. 0) then
         pe1 = (lb- 1 + SHIFT)/size
         dp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = lb
            U1 = MOD(ENV(2)*size -1 - SHIFT, size) +1 
            len1 = U1-L1+1
            type = 255+dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dp1, type)
         end if
         
         pe2 = (ub- 1 + SHIFT)/size
         dp2 = KXGDNO(ENV(1), 0, pe2)
         L2 = MOD(ENV(2)*size - SHIFT, size)+1
         U2 = size
         len2 = U2-L2+1
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dp2, type)
         end if
         
      end if

CC receiving side

      if (SHIFT .LT. 0) then
         in = lb
         loc_shift = - SHIFT
         if (loc_shift .LT. size) then
            do i = lb+loc_shift, ub
               RESULT(i-loc_shift) = ARRAY(i)
               in = in + 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (sp1 .NE. ENV(1)) then
            type = 255+ENV(1)
            status = KXREAD(RESULT(in),len1*intSize,sp1, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = bound
               end do
            end if
            in = in + len1
         end if
         
         sp2 = KXGDNO(ENV(1), 0, pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            type = 355+ENV(1)
            status = KXREAD(RESULT(in), len2*intSize, sp2, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
      else if (SHIFT .GT. 0) then
         in = lb
         if (SHIFT .LT. size) then
            in = ub
            do i = ub-SHIFT, lb, - 1
               RESULT(i+SHIFT) = ARRAY(i)
               in = in - 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (sp1 .NE. ENV(1)) then
            in = ub-len1+1
            type = 255+ENV(1)
            src = sp1
            status = KXREAD(RESULT(in),len1*intSize,src, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
         sp2 = KXGDNO(ENV(1), 0, -pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            in = lb
            type = 355+ENV(1)
            dest = sp2
            status = KXREAD(RESULT(in), len2*intSize, dest, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
         if ((sp2 .EQ. ENV(1)) .AND. (sp1 .EQ. ENV(1))) then
            do i = lb, lb+SHIFT
               RESULT(i) = bound
            end do
         end if
      end if
      
      return
      end 





CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      subroutine EOSHIFT_1_D(ARRAY, a1, a2, ARRAY_INFO, SHIFT, 
     &     RESULT, r1, r2, RESULT_INFO, PROCLIST)
      
      integer a1, a2, r1, r2, ARRAY_INFO(8,7), RESULT_INFO(8,7)
      double precision ARRAY(a1:a2), RESULT(r1:r2)
      integer SHIFT, PROCLIST(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      double precision bound
      integer ENV(4), nproc(2)
      integer intSize, doubleSize
      data doubleSize, intSize/8, 4/
      integer lb, ub, size, i
      integer type, status, in
      integer sp1, sp2, dp1, dp2, L1, L2, U1, U2, loc_shift
      integer pe1, pe2, len1, len2
      integer coord1(2), coord2(2)
      integer dest, src
      
      nproc(1) = ARRAY_INFO(8,1)
      status = KXGDIN(1, nproc)
      status = KXPARA(ENV)
      bound = 0.0
      lb   = ARRAY_INFO(1,1)
      ub   = ARRAY_INFO(2,1)
      size = ub - lb + 1
      status = KXGDCO(ENV(1), coord1)

      SHIFT = -SHIFT
      if (SHIFT .LT. 0) then
         loc_shift = -SHIFT
         pe1 = (lb - 1 + loc_shift)/size
         dp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = MOD(loc_shift, size) + 1
            U1 = size
            len1 = U1-L1+1
            type = 255+dp1
            dest = dp1
            status = KXWRIT(ARRAY(L1), len1*doubleSize, dest, type)
         end if
         
         pe2 = (ub - 1 + loc_shift)/size
         dp2 = KXGDNO(ENV(1), 0, -pe2)
         L2 = lb
         U2 = MOD(loc_shift -1, size)+1
         len2 = U2-L2+1
         dest = dp2
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*doubleSize, dest, type)
         end if
         
      else if (SHIFT .GT. 0) then
         pe1 = (lb- 1 + SHIFT)/size
         dp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = lb
            U1 = MOD(ENV(2)*size -1 - SHIFT, size) +1 
            len1 = U1-L1+1
            type = 255+dp1
            status = KXWRIT(ARRAY(L1), len1*doubleSize, dp1, type)
         end if
         
         pe2 = (ub- 1 + SHIFT)/size
         dp2 = KXGDNO(ENV(1), 0, pe2)
         L2 = MOD(ENV(2)*size - SHIFT, size)+1
         U2 = size
         len2 = U2-L2+1
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*doubleSize, dp2, type)
         end if
         
      end if

CC receiving side

      if (SHIFT .LT. 0) then
         in = lb
         loc_shift = - SHIFT
         if (loc_shift .LT. size) then
            do i = lb+loc_shift, ub
               RESULT(i-loc_shift) = ARRAY(i)
               in = in + 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (sp1 .NE. ENV(1)) then
            type = 255+ENV(1)
            status = KXREAD(RESULT(in),len1*doubleSize,sp1, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = bound
               end do
            end if
            in = in + len1
         end if
         
         sp2 = KXGDNO(ENV(1), 0, pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            type = 355+ENV(1)
            status = KXREAD(RESULT(in), len2*doubleSize, sp2, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
      else if (SHIFT .GT. 0) then
         in = lb
         if (SHIFT .LT. size) then
            in = ub
            do i = ub-SHIFT, lb, - 1
               RESULT(i+SHIFT) = ARRAY(i)
               in = in - 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (sp1 .NE. ENV(1)) then
            in = ub-len1+1
            type = 255+ENV(1)
            src = sp1
            status = KXREAD(RESULT(in),len1*doubleSize,src, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
         sp2 = KXGDNO(ENV(1), 0, -pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            in = lb
            type = 355+ENV(1)
            dest = sp2
            status = KXREAD(RESULT(in), len2*doubleSize, dest, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = bound
               end do
            end if
         end if
         
         if ((sp2 .EQ. ENV(1)) .AND. (sp1 .EQ. ENV(1))) then
            do i = lb, lb+SHIFT
               RESULT(i) = bound
            end do
         end if
      end if
      
      return
      end 





CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      subroutine EOSHIFT_B_1_I(ARRAY, a1, a2, ARRAY_INFO, SHIFT, 
     &     BOUND, RESULT, r1, r2, RESULT_INFO, PROCLIST)

      integer a1, a2, r1, r2, ARRAY_INFO(8,7), RESULT_INFO(8,7)
      integer ARRAY(a1:a2), RESULT(r1:r2)
      integer SHIFT, BOUND, PROCLIST(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), nproc(2)
      integer intSize, realSize
      data realSize, intSize/4, 4/
      integer lb, ub, size, i
      integer type, status, in
      integer sp1, sp2, dp1, dp2, L1, L2, U1, U2, loc_shift
      integer pe1, pe2, len1, len2
      integer coord1(2), coord2(2)
      integer dest, src

      nproc(1) = ARRAY_INFO(8,1)
      status = KXGDIN(1, nproc)
      status = KXPARA(ENV)
      lb   = ARRAY_INFO(1,1)
      ub   = ARRAY_INFO(2,1)
      size = ub - lb + 1
      status = KXGDCO(ENV(1), coord1)
      
      SHIFT = -SHIFT
      if (SHIFT .LT. 0) then
         loc_shift = -SHIFT
         pe1 = (lb - 1 + loc_shift)/size
         dp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = MOD(loc_shift, size) + 1
            U1 = size
            len1 = U1-L1+1
            type = 255+dp1
            dest = dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dest, type)
         end if
         
         pe2 = (ub - 1 + loc_shift)/size
         dp2 = KXGDNO(ENV(1), 0, -pe2)
         L2 = lb
         U2 = MOD(loc_shift -1, size)+1
         len2 = U2-L2+1
         dest = dp2
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dest, type)
         end if
         
      else if (SHIFT .GT. 0) then
         pe1 = (lb- 1 + SHIFT)/size
         dp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = lb
            U1 = MOD(ENV(2)*size -1 - SHIFT, size) +1 
            len1 = U1-L1+1
            type = 255+dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dp1, type)
         end if
         
         pe2 = (ub- 1 + SHIFT)/size
         dp2 = KXGDNO(ENV(1), 0, pe2)
         L2 = MOD(ENV(2)*size - SHIFT, size)+1
         U2 = size
         len2 = U2-L2+1
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dp2, type)
         end if
         
      end if
      
CC    receiving side
      
      if (SHIFT .LT. 0) then
         in = lb
         loc_shift = - SHIFT
         if (loc_shift .LT. size) then
            do i = lb+loc_shift, ub
               RESULT(i-loc_shift) = ARRAY(i)
               in = in + 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (sp1 .NE. ENV(1)) then
            type = 255+ENV(1)
            status = KXREAD(RESULT(in),len1*intSize,sp1, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = BOUND
               end do
            end if
            in = in + len1
         end if
         
         sp2 = KXGDNO(ENV(1), 0, pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            type = 355+ENV(1)
            status = KXREAD(RESULT(in), len2*intSize, sp2, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
      else if (SHIFT .GT. 0) then
         in = lb
         if (SHIFT .LT. size) then
            in = ub
            do i = ub-SHIFT, lb, - 1
               RESULT(i+SHIFT) = ARRAY(i)
               in = in - 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (sp1 .NE. ENV(1)) then
            in = ub-len1+1
            type = 255+ENV(1)
            src = sp1
            status = KXREAD(RESULT(in),len1*intSize,src, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
         sp2 = KXGDNO(ENV(1), 0, -pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            in = lb
            type = 355+ENV(1)
            dest = sp2
            status = KXREAD(RESULT(in), len2*intSize, dest, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
         if ((sp2 .EQ. ENV(1)) .AND. (sp1 .EQ. ENV(1))) then
            if (ENV(1) .EQ. 0) then
               RESULT(i) = BOUND
            end if
         end if
      end if
      
      return
      end 




CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      subroutine EOSHIFT_B_1_R(ARRAY, a1, a2, ARRAY_INFO, SHIFT, 
     &     BOUND, RESULT, r1, r2, RESULT_INFO, PROCLIST)

      integer a1, a2, r1, r2, ARRAY_INFO(8,7), RESULT_INFO(8,7)
      real ARRAY(a1:a2), RESULT(r1:r2)
      integer SHIFT, BOUND, PROCLIST(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), nproc(2)
      integer intSize, realSize
      data realSize, intSize/4, 4/
      integer lb, ub, size, i
      integer type, status, in
      integer sp1, sp2, dp1, dp2, L1, L2, U1, U2, loc_shift
      integer pe1, pe2, len1, len2
      integer coord1(2), coord2(2)
      integer dest, src

      nproc(1) = ARRAY_INFO(8,1)
      status = KXGDIN(1, nproc)
      status = KXPARA(ENV)
      lb   = ARRAY_INFO(1,1)
      ub   = ARRAY_INFO(2,1)
      size = ub - lb + 1
      status = KXGDCO(ENV(1), coord1)
      
      SHIFT = -SHIFT
      if (SHIFT .LT. 0) then
         loc_shift = -SHIFT
         pe1 = (lb - 1 + loc_shift)/size
         dp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = MOD(loc_shift, size) + 1
            U1 = size
            len1 = U1-L1+1
            type = 255+dp1
            dest = dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dest, type)
         end if
         
         pe2 = (ub - 1 + loc_shift)/size
         dp2 = KXGDNO(ENV(1), 0, -pe2)
         L2 = lb
         U2 = MOD(loc_shift -1, size)+1
         len2 = U2-L2+1
         dest = dp2
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dest, type)
         end if
         
      else if (SHIFT .GT. 0) then
         pe1 = (lb- 1 + SHIFT)/size
         dp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = lb
            U1 = MOD(ENV(2)*size -1 - SHIFT, size) +1 
            len1 = U1-L1+1
            type = 255+dp1
            status = KXWRIT(ARRAY(L1), len1*intSize, dp1, type)
         end if
         
         pe2 = (ub- 1 + SHIFT)/size
         dp2 = KXGDNO(ENV(1), 0, pe2)
         L2 = MOD(ENV(2)*size - SHIFT, size)+1
         U2 = size
         len2 = U2-L2+1
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*intSize, dp2, type)
         end if
         
      end if
      
CC    receiving side
      
      if (SHIFT .LT. 0) then
         in = lb
         loc_shift = - SHIFT
         if (loc_shift .LT. size) then
            do i = lb+loc_shift, ub
               RESULT(i-loc_shift) = ARRAY(i)
               in = in + 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (sp1 .NE. ENV(1)) then
            type = 255+ENV(1)
            status = KXREAD(RESULT(in),len1*intSize,sp1, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = BOUND
               end do
            end if
            in = in + len1
         end if
         
         sp2 = KXGDNO(ENV(1), 0, pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            type = 355+ENV(1)
            status = KXREAD(RESULT(in), len2*intSize, sp2, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
      else if (SHIFT .GT. 0) then
         in = lb
         if (SHIFT .LT. size) then
            in = ub
            do i = ub-SHIFT, lb, - 1
               RESULT(i+SHIFT) = ARRAY(i)
               in = in - 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (sp1 .NE. ENV(1)) then
            in = ub-len1+1
            type = 255+ENV(1)
            src = sp1
            status = KXREAD(RESULT(in),len1*intSize,src, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
         sp2 = KXGDNO(ENV(1), 0, -pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            in = lb
            type = 355+ENV(1)
            dest = sp2
            status = KXREAD(RESULT(in), len2*intSize, dest, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
         if ((sp2 .EQ. ENV(1)) .AND. (sp1 .EQ. ENV(1))) then
            if (ENV(1) .EQ. 0) then
               RESULT(i) = BOUND
            end if
         end if
      end if
      
      return
      end 



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine EOSHIFT_B_1_D(ARRAY, a1, a2, ARRAY_INFO, SHIFT, 
     &     BOUND, RESULT, r1, r2, RESULT_INFO, PROCLIST)

      integer a1, a2, r1, r2, ARRAY_INFO(8,7), RESULT_INFO(8,7)
      double precision ARRAY(a1:a2), RESULT(r1:r2)
      integer SHIFT, BOUND, PROCLIST(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), nproc(2)
      integer intSize, doubleSize
      data doubleSize, intSize/8, 4/
      integer lb, ub, size, i
      integer type, status, in
      integer sp1, sp2, dp1, dp2, L1, L2, U1, U2, loc_shift
      integer pe1, pe2, len1, len2
      integer coord1(2), coord2(2)
      integer dest, src

      nproc(1) = ARRAY_INFO(8,1)
      status = KXGDIN(1, nproc)
      status = KXPARA(ENV)
      lb   = ARRAY_INFO(1,1)
      ub   = ARRAY_INFO(2,1)
      size = ub - lb + 1
      status = KXGDCO(ENV(1), coord1)
      
      SHIFT = -SHIFT
      if (SHIFT .LT. 0) then
         loc_shift = -SHIFT
         pe1 = (lb - 1 + loc_shift)/size
         dp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = MOD(loc_shift, size) + 1
            U1 = size
            len1 = U1-L1+1
            type = 255+dp1
            dest = dp1
            status = KXWRIT(ARRAY(L1), len1*doubleSize, dest, type)
         end if
         
         pe2 = (ub - 1 + loc_shift)/size
         dp2 = KXGDNO(ENV(1), 0, -pe2)
         L2 = lb
         U2 = MOD(loc_shift -1, size)+1
         len2 = U2-L2+1
         dest = dp2
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*doubleSize, dest, type)
         end if
         
      else if (SHIFT .GT. 0) then
         pe1 = (lb- 1 + SHIFT)/size
         dp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (dp1 .NE. ENV(1)) then
            L1 = lb
            U1 = MOD(ENV(2)*size -1 - SHIFT, size) +1 
            len1 = U1-L1+1
            type = 255+dp1
            status = KXWRIT(ARRAY(L1), len1*doubleSize, dp1, type)
         end if
         
         pe2 = (ub- 1 + SHIFT)/size
         dp2 = KXGDNO(ENV(1), 0, pe2)
         L2 = MOD(ENV(2)*size - SHIFT, size)+1
         U2 = size
         len2 = U2-L2+1
         if ((dp2 .NE. ENV(1)) .AND. (dp2 .NE. dp1)) then
            type = 355+dp2
            status = KXWRIT(ARRAY(L2), len2*doubleSize, dp2, type)
         end if
         
      end if
      
CC    receiving side
      
      if (SHIFT .LT. 0) then
         in = lb
         loc_shift = - SHIFT
         if (loc_shift .LT. size) then
            do i = lb+loc_shift, ub
               RESULT(i-loc_shift) = ARRAY(i)
               in = in + 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, pe1)
         
         if (sp1 .NE. ENV(1)) then
            type = 255+ENV(1)
            status = KXREAD(RESULT(in),len1*doubleSize,sp1, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = BOUND
               end do
            end if
            in = in + len1
         end if
         
         sp2 = KXGDNO(ENV(1), 0, pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            type = 355+ENV(1)
            status = KXREAD(RESULT(in), len2*doubleSize, sp2, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .GE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
      else if (SHIFT .GT. 0) then
         in = lb
         if (SHIFT .LT. size) then
            in = ub
            do i = ub-SHIFT, lb, - 1
               RESULT(i+SHIFT) = ARRAY(i)
               in = in - 1
            end do
         end if
         
         sp1 = KXGDNO(ENV(1), 0, -pe1)
         
         if (sp1 .NE. ENV(1)) then
            in = ub-len1+1
            type = 255+ENV(1)
            src = sp1
            status = KXREAD(RESULT(in),len1*doubleSize,src, type)
            status = KXGDCO(sp1, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len1-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
         sp2 = KXGDNO(ENV(1), 0, -pe2)
         if ((sp2 .NE. ENV(1)) .AND. (sp2 .NE. sp1)) then
            in = lb
            type = 355+ENV(1)
            dest = sp2
            status = KXREAD(RESULT(in), len2*doubleSize, dest, type)
            status = KXGDCO(sp2, coord2)
            if (coord1(1) .LE. coord2(1)) then
               do i = 0, len2-1
                  RESULT(in+i) = BOUND
               end do
            end if
         end if
         
         if ((sp2 .EQ. ENV(1)) .AND. (sp1 .EQ. ENV(1))) then
            if (ENV(1) .EQ. 0) then
               RESULT(i) = BOUND
            end if
         end if
      end if
      
      return
      end 



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine EOSHIFT_2_I_S(array, a1, a2, a3, a4, array_info, 
     &  shift, dim, result, r1, r2, r3, r4, result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i
      integer array(a1:a2, a3:a4), shift, result(r1:r2,r3:r4)
      integer bound(1024), temp_shift(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024
         temp_shift(i) = shift
         bound(i) = 0
      end do

      call EOSHIFT_B_V_2_I_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, bound, 1, 1024, bound_info,
     & dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_2_I_V(array, a1, a2, a3, a4, array_info, 
     &  shift, s1, s2, shift_info, dim, result, r1, r2, r3, r4, 
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, s1, s2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i
      integer array(a1:a2,a3:a4), shift(s1:s2), result(r1:r2,r3:r4)
      integer bound(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024
         bound(i) = 0
      end do

      call EOSHIFT_B_V_2_I_V(array, a1, a2, a3, a4, array_info, 
     & shift, s1, s2, shift_info, bound, 1, 1024, bound_info,
     & dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_S_2_I_S(array, a1, a2, a3, a4, array_info, 
     &  shift, bound,  dim, result, r1, r2, r3, r4, 
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound
      integer array(a1:a2,a3:a4), shift, result(r1:r2,r3:r4)
      integer temp_bound(1024), temp_shift(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_shift(i) = shift
         temp_bound(i) = bound
      end do

      call EOSHIFT_B_V_2_I_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, temp_bound, 1, 1024, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_S_2_I_V(array, a1, a2, a3, a4, array_info, 
     &  shift, s1, s2, shift_info, bound, dim, result, r1, r2, r3, r4,
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, s1, s2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound
      integer array(a1:a2,a3:a4), shift(s1:s2), result(r1:r2,r3:r4)
      integer temp_bound(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_bound(i) = bound
      end do

      call EOSHIFT_B_V_2_I_V(array, a1, a2, a3, a4, array_info, 
     & shift, s1, s2, shift_info, temp_bound, 1, 1024, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_V_2_I_S(array, a1, a2, a3, a4, array_info, 
     &  shift, bound, b1, b2, bound_info, dim, result, r1, r2, r3, r4,
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, b1, b2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound(b1:b2)
      integer array(a1:a2,a3:a4), result(r1:r2,r3:r4), shift
      integer temp_shift(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_shift(i) = shift
      end do

      call EOSHIFT_B_V_2_I_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, bound, b1, b2, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_V_2_I_V(array, a1, a2, a3, a4, array_info, 
     &     shift, s1, s2, shift_info, bound, b1, b2, bound_info, dim, 
     &     result, r1, r2, r3, r4, result_info, proclist)

      integer a1, a2, a3, a4, s1, s2, b1, b2, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim
      integer array(a1:a2, a3:a4), shift(s1:s2), bound(b1:b2)
      integer result(r1:r2,r3:r4)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      logical more
      integer temp(1024), temp2(1024), asize, shift_size
      integer direc(1024), nproc(2)
      integer lb1, lb2, ub1, ub2, size1, size2, i, j

      nproc(1) = array_info(8,2)
      nproc(2) = array_info(8,1)
      status = KXGDIN(2,nproc)
      
      lb1 = array_info(1,1)
      lb2 = array_info(1,2)
      ub1 = array_info(2,1)
      ub2 = array_info(2,2)
      
      size1 = ub1 - lb1 + 1
      size2 = ub2 - lb2 + 1
      shift_size = s2 - s1 + 1
      
      do i = lb1, ub1
         do j = lb2, ub2
            result(i,j) = array(i,j)
         end do
      end do

      do i=s1, s2
         shift(i) = -shift(i)
      end do

      if (dim .EQ. 1) then
         asize = size2
      else if (dim .EQ. 2) then
         asize = size1
      end if

      do i = 1, shift_size
         if (shift(i) .GE. 0) then
            direc(i) = 1
         else
            direc(i) = -1
         end if
         temp2(i) = ABS(shift(i))
      end do

      more = .TRUE.
      do while(more)
         do i = 1, shift_size
            if (temp2(i) .GT. asize) then
               temp(i) = asize
               temp2(i) = temp2(i) - asize
            else
               temp(i) = temp2(i)
               temp2(i) = 0
            end if
         end do
         call eoshift_2d_2_I(result, r1, r2, r3, r4,result_info,temp,
     &        dim, direc, bound)
         
         more = .FALSE.
         do i = 1, shift_size
            if (temp2(i) .GT. 0) then
               more = .TRUE.
            end if
         end do
      end do
      
      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      subroutine eoshift_2d_2_I(array,a1,a2,a3,a4,array_info,shift,
     &     dim, direc, bound)

      integer a1, a2, a3, a4, array_info(8,7)
      integer array(a1:a2,a3:a4)
      integer dim, shift(*), direc(*), bound(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), shift_size, nproc(2)
      integer intSize, realSize
      data realSize, intSize/4, 4/
      integer i, j, k, lnode, rnode,unode, dnode
      integer lb1, ub1, size1, size2
      integer lb2, ub2
      integer type, status, temp
      integer rec_buff(1024), send_buff(1024), len
      integer coord(2)
      

      status = KXPARA(ENV)
      lb1   = array_info(1,1)
      ub1   = array_info(2,1)
      size1 = ub1 - lb1 + 1
      lb2   = array_info(1,2)
      ub2   = array_info(2,2)
      size2 = ub2 - lb2 + 1
      shift_size = array_info(2,dim) - array_info(1,dim) + 1
      
      status = KXGDCO(ENV(1), coord)
      
      if (dim .EQ. 2) then
         len = 0
C     communicate with negative side
         do i = lb1, ub1
            if (direc(i) .LT. 0) then
               temp = -shift(i)
               do j = 0, shift(i) -1
                  len = len + 1
                  send_buff(len) = array(i, lb2+j)
               end do
               do k = lb2+shift(i), ub2
                  array(i, k-shift(i)) = array(i, k)
               end do 
            end if
         end do
         if (len .GT. 0) then
            lnode = KXGDNO(ENV(1), 0, -1)
            type = 255+lnode
            status = KXWRIT(send_buff, len*intSize, lnode, type)
            rnode = KXGDNO(ENV(1), 0, 1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,rnode, type)
            
            len = 1
            if (coord(1) .EQ. (nproc(1) - 1)) then
               do i = lb1, ub1
                  if (direc(i) .LT. 0) then
                     do k = 1, shift(i)
                        array(i, ub2-shift(i)+k) = bound(i)
                     end do
                  end if
               end do
            else
               
               do i = lb1, ub1
                  if (direc(i) .LT. 0) then
                     do k = 1, shift(i)
                        array(i, ub2-shift(i)+k) 
     &                       = rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
         
         len = 0
         do i = lb1, ub1
C     communicate with positive side
            if (direc(i) .GT. 0) then
               do j = 1, shift(i)
                  len = len + 1
                  send_buff(len) = array(i, ub2-shift(i)+j)
               end do
               do k = ub2-shift(i), lb2 -1
                  array(i, k+shift(i)) = array(i, k)
               end do 
            end if
         end do
         if (len .GT. 0) then
            rnode = KXGDNO(ENV(1), 0, 1)
            type = 255+rnode
            status = KXWRIT(send_buff, len*intSize, rnode, type)
            lnode = KXGDNO(ENV(1), 0, -1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,lnode, type)
            
            len = 1
            if (coord(1) .EQ. 0) then
               do i = lb1, ub1
                  if (shift(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(i,lb2+k)=bound(i)
                     end do
                  end if
               end do
            else
               
               do i = lb1, ub1
                  if (shift(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(i,lb2+k)=rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
CCCC  
CCCCCCCCCCCCCif dimension 1
CCCC  
        
      else if (dim .EQ. 1) then
         len = 0
         do i = lb2, ub2
C     communicate with negative side
            if (direc(i) .LT. 0) then
               temp = - shift(i)
               do j = 0, shift(i) -1
                  len = len + 1
                  send_buff(len) = array(lb1+j,i)
               end do
               do k = lb1+shift(i), ub1
                  array(k-shift(i),i) = array(k,i)
               end do 
            end if
         end do
         if (len .GT. 0) then
            unode = KXGDNO(ENV(1), 1, 1)
            type = 255+unode
            status = KXWRIT(send_buff, len*intSize, unode, type)
            dnode = KXGDNO(ENV(1), 1, -1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,dnode, type)
            len = 1
            if (coord(2) .EQ. 0) then
               do i = lb2, ub2
                  if (direc(i) .LT. 0) then
                     temp = -shift(i)
                     do k = 1, shift(i)
                        array(ub1-shift(i)+k,i)  = bound(i)
                     end do
                  end if
               end do
            else
               do i = lb2, ub2
                  if (direc(i) .LT. 0) then
                     temp = -shift(i)
                     do k = 1, shift(i)
                        array(ub1-shift(i)+k,i) 
     &                       = rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
         
         len = 0
         do i = lb2, ub2
C     communicate with positive side
            if (direc(i) .GT. 0) then
               do j = 1, shift(i)
                  len = len + 1
                  send_buff(len) = array(ub1-shift(i)+j,i)
               end do
               do k = ub1-shift(i), lb1, -1
                  array(k+shift(i),i) = array(k,i)
               end do 
            end if
         end do
         if (len .GT. 0) then
            dnode = KXGDNO(ENV(1), 1, -1)
            type = 255+dnode
            status = KXWRIT(send_buff, len*intSize, dnode, type)
            unode = KXGDNO(ENV(1), 1, 1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,unode, type)
            
            len = 1
            if (coord(2) .EQ. (nproc(2) -1)) then
               do i = lb2, ub2
                  if (direc(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(lb1+k,i)=bound(i)
                     end do
                  end if
               end do
            else
               do i = lb2, ub2
                  if (direc(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(lb1+k,i)=rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
      end if
      
      return
      end




CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine EOSHIFT_2_R_S(array, a1, a2, a3, a4, array_info, 
     &  shift, dim, result, r1, r2, r3, r4, result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i
      real array(a1:a2,a3:a4), bound(1024), result(r1:r2,r3:r4)
      integer temp_shift(1024), shift

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024
         temp_shift(i) = shift
         bound(i) = 0.0
      end do

      call EOSHIFT_B_V_2_R_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, bound, 1, 1024, bound_info,
     & dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_2_R_V(array, a1, a2, a3, a4, array_info, 
     &  shift, s1, s2, shift_info, dim, result, r1, r2, r3, r4, 
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, s1, s2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, shift(s1:s2)
      real array(a1:a2,a3:a4), result(r1:r2,r3:r4), bound(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024
         bound(i) = 0.0
      end do

      call EOSHIFT_B_V_2_R_V(array, a1, a2, a3, a4, array_info, 
     & shift, s1, s2, shift_info, bound, 1, 1024, bound_info,
     & dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_S_2_R_S(array, a1, a2, a3, a4, array_info, 
     &  shift, bound,  dim, result, r1, r2, r3, r4, 
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound
      real array(a1:a2,a3:a4), temp_bound(1024), result(r1:r2,r3:r4)
      integer shift, temp_shift(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_shift(i) = shift
         temp_bound(i) = bound
      end do

      call EOSHIFT_B_V_2_R_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, temp_bound, 1, 1024, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_S_2_R_V(array, a1, a2, a3, a4, array_info, 
     &  shift, s1, s2, shift_info, bound, dim, result, r1, r2, r3, r4,
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, s1, s2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound
      real array(a1:a2,a3:a4), temp_bound(1024), result(r1:r2,r3:r4)
      integer shift(s1:s2)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_bound(i) = bound
      end do

      call EOSHIFT_B_V_2_R_V(array, a1, a2, a3, a4, array_info, 
     & shift, s1, s2, shift_info, temp_bound, 1, 1024, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_V_2_R_S(array, a1, a2, a3, a4, array_info, 
     &  shift, bound, b1, b2, bound_info, dim, result, r1, r2, r3, r4,
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, b1, b2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i
      real array(a1:a2,a3:a4), result(r1:r2,r3:r4), bound(b1:b2)
      integer temp_shift(1024), shift

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_shift(i) = shift
      end do

      call EOSHIFT_B_V_2_R_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, bound, b1, b2, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_V_2_R_V(array, a1, a2, a3, a4, array_info, 
     &     shift, s1, s2, shift_info, bound, b1, b2, bound_info, dim, 
     &     result, r1, r2, r3, r4, result_info, proclist)

      integer a1, a2, a3, a4, s1, s2, b1, b2, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, shift(s1:s2)
      real array(a1:a2,a3:a4), result(r1:r2,r3:r4), bound(b1:b2)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      logical more
      integer temp(1024), temp2(1024), asize, shift_size
      integer direc(1024), nproc(2)
      integer lb1, lb2, ub1, ub2, size1, size2, i, j

      nproc(1) = array_info(8,2)
      nproc(2) = array_info(8,1)
      status = KXGDIN(2,nproc)
      
      lb1 = array_info(1,1)
      lb2 = array_info(1,2)
      ub1 = array_info(2,1)
      ub2 = array_info(2,2)
      
      size1 = ub1 - lb1 + 1
      size2 = ub2 - lb2 + 1
      shift_size = s2 - s1 + 1
      
      do i = lb1, ub1
         do j = lb2, ub2
            result(i,j) = array(i,j)
         end do
      end do

      do i=s1, s2
         shift(i) = -shift(i)
      end do

      if (dim .EQ. 1) then
         asize = size2
      else if (dim .EQ. 2) then
         asize = size1
      end if

      do i = 1, shift_size
         if (shift(i) .GE. 0) then
            direc(i) = 1
         else
            direc(i) = -1
         end if
         temp2(i) = ABS(shift(i))
      end do

      more = .TRUE.
      do while(more)
         do i = 1, shift_size
            if (temp2(i) .GT. asize) then
               temp(i) = asize
               temp2(i) = temp2(i) - asize
            else
               temp(i) = temp2(i)
               temp2(i) = 0
            end if
         end do

         call eoshift_2d_2_R(result, r1, r2, r3, r4, result_info,temp,
     &        dim, direc, bound)
         
         more = .FALSE.
         do i = 1, shift_size
            if (temp2(i) .GT. 0) then
               more = .TRUE.
            end if
         end do
      end do
      
      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine eoshift_2d_2_R(array,a1,a2,a3,a4,array_info,shift,
     &     dim, direc, bound)

      integer a1, a2, a3, a4, array_info(8,7)
      real array(a1:a2,a3:a4), bound(*)
      integer dim, shift(*), direc(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), shift_size, nproc(2)
      integer intSize, realSize
      data realSize, intSize/4, 4/
      integer i, j, k, lnode, rnode,unode, dnode
      integer lb1, ub1, size1, size2, len
      integer lb2, ub2, type, status, temp
      real rec_buff(1024), send_buff(1024)
      integer coord(2)
      
      status = KXPARA(ENV)
      lb1   = array_info(1,1)
      ub1   = array_info(2,1)
      size1 = ub1 - lb1 + 1
      lb2   = array_info(1,2)
      ub2   = array_info(2,2)
      size2 = ub2 - lb2 + 1
      shift_size = array_info(2,dim) - array_info(1,dim) + 1
      
      status = KXGDCO(ENV(1), coord)
      
      if (dim .EQ. 2) then
         len = 0
C     communicate with negative side
         do i = lb1, ub1
            if (direc(i) .LT. 0) then
               temp = -shift(i)
               do j = 0, shift(i) -1
                  len = len + 1
                  send_buff(len) = array(i, lb2+j)
               end do
               do k = lb2+shift(i), ub2
                  array(i, k-shift(i)) = array(i, k)
               end do 
            end if
         end do
         if (len .GT. 0) then
            lnode = KXGDNO(ENV(1), 0, -1)
            type = 255+lnode
            status = KXWRIT(send_buff, len*intSize, lnode, type)
            rnode = KXGDNO(ENV(1), 0, 1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,rnode, type)
            
            len = 1
            if (coord(1) .EQ. (nproc(1) - 1)) then
               do i = lb1, ub1
                  if (direc(i) .LT. 0) then
                     do k = 1, shift(i)
                        array(i, ub2-shift(i)+k) = bound(i)
                     end do
                  end if
               end do
            else
               
               do i = lb1, ub1
                  if (direc(i) .LT. 0) then
                     do k = 1, shift(i)
                        array(i, ub2-shift(i)+k) 
     &                       = rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
         
         len = 0
         do i = lb1, ub1
C     communicate with positive side
            if (direc(i) .GT. 0) then
               do j = 1, shift(i)
                  len = len + 1
                  send_buff(len) = array(i, ub2-shift(i)+j)
               end do
               do k = ub2-shift(i), lb2 -1
                  array(i, k+shift(i)) = array(i, k)
               end do 
            end if
         end do
         if (len .GT. 0) then
            rnode = KXGDNO(ENV(1), 0, 1)
            type = 255+rnode
            status = KXWRIT(send_buff, len*intSize, rnode, type)
            lnode = KXGDNO(ENV(1), 0, -1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,lnode, type)
            
            len = 1
            if (coord(1) .EQ. 0) then
               do i = lb1, ub1
                  if (shift(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(i,lb2+k)=bound(i)
                     end do
                  end if
               end do
            else
               
               do i = lb1, ub1
                  if (shift(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(i,lb2+k)=rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
CCCC  
CCCCCCCCCCCCCif dimension 1
CCCC  
        
      else if (dim .EQ. 1) then
         len = 0
         do i = lb2, ub2
C     communicate with negative side
            if (direc(i) .LT. 0) then
               temp = - shift(i)
               do j = 0, shift(i) -1
                  len = len + 1
                  send_buff(len) = array(lb1+j,i)
               end do
               do k = lb1+shift(i), ub1
                  array(k-shift(i),i) = array(k,i)
               end do 
            end if
         end do
         if (len .GT. 0) then
            unode = KXGDNO(ENV(1), 1, 1)
            type = 255+unode
            status = KXWRIT(send_buff, len*intSize, unode, type)
            dnode = KXGDNO(ENV(1), 1, -1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,dnode, type)
            len = 1
            if (coord(2) .EQ. 0) then
               do i = lb2, ub2
                  if (direc(i) .LT. 0) then
                     temp = -shift(i)
                     do k = 1, shift(i)
                        array(ub1-shift(i)+k,i)  = bound(i)
                     end do
                  end if
               end do
            else
               do i = lb2, ub2
                  if (direc(i) .LT. 0) then
                     temp = -shift(i)
                     do k = 1, shift(i)
                        array(ub1-shift(i)+k,i) 
     &                       = rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
         
         len = 0
         do i = lb2, ub2
C     communicate with positive side
            if (direc(i) .GT. 0) then
               do j = 1, shift(i)
                  len = len + 1
                  send_buff(len) = array(ub1-shift(i)+j,i)
               end do
               do k = ub1-shift(i), lb1, -1
                  array(k+shift(i),i) = array(k,i)
               end do 
            end if
         end do
         if (len .GT. 0) then
            dnode = KXGDNO(ENV(1), 1, -1)
            type = 255+dnode
            status = KXWRIT(send_buff, len*intSize, dnode, type)
            unode = KXGDNO(ENV(1), 1, 1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*intSize,unode, type)
            
            len = 1
            if (coord(2) .EQ. (nproc(2) -1)) then
               do i = lb2, ub2
                  if (direc(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(lb1+k,i)=bound(i)
                     end do
                  end if
               end do
            else
               do i = lb2, ub2
                  if (direc(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(lb1+k,i)=rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
      end if
      
      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine EOSHIFT_2_D_S(array, a1, a2, a3, a4, array_info, 
     &  shift, dim, result, r1, r2, r3, r4, result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i
      double precision  array(a1:a2,a3:a4), bound(1024)
      double precision result(r1:r2,r3:r4)
      integer temp_shift(1024), shift

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024
         temp_shift(i) = shift
         bound(i) = 0.0
      end do

      call EOSHIFT_B_V_2_D_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, bound, 1, 1024, bound_info,
     & dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_2_D_V(array, a1, a2, a3, a4, array_info, 
     &  shift, s1, s2, shift_info, dim, result, r1, r2, r3, r4, 
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, s1, s2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, shift(s1:s2)
      double precision array(a1:a2,a3:a4), result(r1:r2,r3:r4)
      double precision bound(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024
         bound(i) = 0.0
      end do

      call EOSHIFT_B_V_2_D_V(array, a1, a2, a3, a4, array_info, 
     & shift, s1, s2, shift_info, bound, 1, 1024, bound_info,
     & dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_S_2_D_S(array, a1, a2, a3, a4, array_info, 
     &  shift, bound,  dim, result, r1, r2, r3, r4, 
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound
      double precision array(a1:a2,a3:a4), temp_bound(1024)
      double precision  result(r1:r2,r3:r4)
      integer shift, temp_shift(1024)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_shift(i) = shift
         temp_bound(i) = bound
      end do

      call EOSHIFT_B_V_2_D_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, temp_bound, 1, 1024, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_S_2_D_V(array, a1, a2, a3, a4, array_info, 
     &  shift, s1, s2, shift_info, bound, dim, result, r1, r2, r3, r4,
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, s1, s2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i, bound
      double precision array(a1:a2,a3:a4), temp_bound(1024)
      double precision  result(r1:r2,r3:r4)
      integer shift(s1:s2)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_bound(i) = bound
      end do

      call EOSHIFT_B_V_2_D_V(array, a1, a2, a3, a4, array_info, 
     & shift, s1, s2, shift_info, temp_bound, 1, 1024, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_V_2_D_S(array, a1, a2, a3, a4, array_info, 
     &  shift, bound, b1, b2, bound_info, dim, result, r1, r2, r3, r4,
     &   result_info, proclist)

      integer a1, a2, a3, a4, r1, r2, r3, r4, b1, b2
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, i
      double precision array(a1:a2,a3:a4), result(r1:r2,r3:r4)
      double precision bound(b1:b2)
      integer temp_shift(1024), shift

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      do i=1, 1024    
         temp_shift(i) = shift
      end do

      call EOSHIFT_B_V_2_D_V(array, a1, a2, a3, a4, array_info, 
     & temp_shift, 1, 1024, shift_info, bound, b1, b2, 
     & bound_info, dim, result, r1, r2, r3, r4, result_info, proclist)

      return 
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EOSHIFT_B_V_2_D_V(array, a1, a2, a3, a4, array_info, 
     &     shift, s1, s2, shift_info, bound, b1, b2, bound_info, dim, 
     &     result, r1, r2, r3, r4, result_info, proclist)

      integer a1, a2, a3, a4, s1, s2, b1, b2, r1, r2, r3, r4
      integer array_info(8,7), result_info(8,7), shift_info(8,7)
      integer bound_info(8,7), proclist(*), dim, shift(s1:s2)
      double precision array(a1:a2,a3:a4), result(r1:r2,r3:r4)
      double precision bound(b1:b2)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      logical more
      integer temp(1024), temp2(1024), asize, shift_size
      integer direc(1024), nproc(2)
      integer lb1, lb2, ub1, ub2, size1, size2, i, j

      nproc(1) = array_info(8,2)
      nproc(2) = array_info(8,1)
      status = KXGDIN(2,nproc)
      
      lb1 = array_info(1,1)
      lb2 = array_info(1,2)
      ub1 = array_info(2,1)
      ub2 = array_info(2,2)
      
      size1 = ub1 - lb1 + 1
      size2 = ub2 - lb2 + 1
      shift_size = s2 - s1 + 1
      
      do i = lb1, ub1
         do j = lb2, ub2
            result(i,j) = array(i,j)
         end do
      end do

      do i=s1, s2
         shift(i) = -shift(i)
      end do

      if (dim .EQ. 1) then
         asize = size2
      else if (dim .EQ. 2) then
         asize = size1
      end if

      do i = 1, shift_size
         if (shift(i) .GE. 0) then
            direc(i) = 1
         else
            direc(i) = -1
         end if
         temp2(i) = ABS(shift(i))
      end do

      more = .TRUE.
      do while(more)
         do i = 1, shift_size
            if (temp2(i) .GT. asize) then
               temp(i) = asize
               temp2(i) = temp2(i) - asize
            else
               temp(i) = temp2(i)
               temp2(i) = 0
            end if
         end do

         call eoshift_2d_2_D(result, r1, r2, r3, r4, result_info,temp,
     &        dim, direc, bound)
         
         more = .FALSE.
         do i = 1, shift_size
            if (temp2(i) .GT. 0) then
               more = .TRUE.
            end if
         end do
      end do
      
      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine eoshift_2d_2_D(array,a1,a2,a3,a4,array_info,shift,
     &     dim, direc, bound)

      integer a1, a2, a3, a4, array_info(8,7)
      double precision array(a1:a2,a3:a4), bound(*)
      integer dim, shift(*), direc(*)
      
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      
      integer ENV(4), shift_size, nproc(2)
      integer intSize, doubleSize
      data doubleSize, intSize/8, 4/
      integer i, j, k, lnode, rnode,unode, dnode
      integer lb1, ub1, size1, size2, len
      integer lb2, ub2, type, status, temp
      double precision rec_buff(1024), send_buff(1024)
      integer coord(2)
      
      status = KXPARA(ENV)
      lb1   = array_info(1,1)
      ub1   = array_info(2,1)
      size1 = ub1 - lb1 + 1
      lb2   = array_info(1,2)
      ub2   = array_info(2,2)
      size2 = ub2 - lb2 + 1
      shift_size = array_info(2,dim) - array_info(1,dim) + 1
      
      status = KXGDCO(ENV(1), coord)
      
      if (dim .EQ. 2) then
         len = 0
C     communicate with negative side
         do i = lb1, ub1
            if (direc(i) .LT. 0) then
               temp = -shift(i)
               do j = 0, shift(i) -1
                  len = len + 1
                  send_buff(len) = array(i, lb2+j)
               end do
               do k = lb2+shift(i), ub2
                  array(i, k-shift(i)) = array(i, k)
               end do 
            end if
         end do
         if (len .GT. 0) then
            lnode = KXGDNO(ENV(1), 0, -1)
            type = 255+lnode
            status = KXWRIT(send_buff, len*doubleSize, lnode, type)
            rnode = KXGDNO(ENV(1), 0, 1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*doubleSize,rnode, type)
            
            len = 1
            if (coord(1) .EQ. (nproc(1) - 1)) then
               do i = lb1, ub1
                  if (direc(i) .LT. 0) then
                     do k = 1, shift(i)
                        array(i, ub2-shift(i)+k) = bound(i)
                     end do
                  end if
               end do
            else
               
               do i = lb1, ub1
                  if (direc(i) .LT. 0) then
                     do k = 1, shift(i)
                        array(i, ub2-shift(i)+k) 
     &                       = rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
         
         len = 0
         do i = lb1, ub1
C     communicate with positive side
            if (direc(i) .GT. 0) then
               do j = 1, shift(i)
                  len = len + 1
                  send_buff(len) = array(i, ub2-shift(i)+j)
               end do
               do k = ub2-shift(i), lb2 -1
                  array(i, k+shift(i)) = array(i, k)
               end do 
            end if
         end do
         if (len .GT. 0) then
            rnode = KXGDNO(ENV(1), 0, 1)
            type = 255+rnode
            status = KXWRIT(send_buff, len*doubleSize, rnode, type)
            lnode = KXGDNO(ENV(1), 0, -1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*doubleSize,lnode, type)
            
            len = 1
            if (coord(1) .EQ. 0) then
               do i = lb1, ub1
                  if (shift(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(i,lb2+k)=bound(i)
                     end do
                  end if
               end do
            else
               
               do i = lb1, ub1
                  if (shift(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(i,lb2+k)=rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
CCCC  
CCCCCCCCCCCCCif dimension 1
CCCC  
        
      else if (dim .EQ. 1) then
         len = 0
         do i = lb2, ub2
C     communicate with negative side
            if (direc(i) .LT. 0) then
               temp = - shift(i)
               do j = 0, shift(i) -1
                  len = len + 1
                  send_buff(len) = array(lb1+j,i)
               end do
               do k = lb1+shift(i), ub1
                  array(k-shift(i),i) = array(k,i)
               end do 
            end if
         end do
         if (len .GT. 0) then
            unode = KXGDNO(ENV(1), 1, 1)
            type = 255+unode
            status = KXWRIT(send_buff, len*doubleSize, unode, type)
            dnode = KXGDNO(ENV(1), 1, -1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*doubleSize,dnode, type)
            len = 1
            if (coord(2) .EQ. 0) then
               do i = lb2, ub2
                  if (direc(i) .LT. 0) then
                     temp = -shift(i)
                     do k = 1, shift(i)
                        array(ub1-shift(i)+k,i)  = bound(i)
                     end do
                  end if
               end do
            else
               do i = lb2, ub2
                  if (direc(i) .LT. 0) then
                     temp = -shift(i)
                     do k = 1, shift(i)
                        array(ub1-shift(i)+k,i) 
     &                       = rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
         
         len = 0
         do i = lb2, ub2
C     communicate with positive side
            if (direc(i) .GT. 0) then
               do j = 1, shift(i)
                  len = len + 1
                  send_buff(len) = array(ub1-shift(i)+j,i)
               end do
               do k = ub1-shift(i), lb1, -1
                  array(k+shift(i),i) = array(k,i)
               end do 
            end if
         end do
         if (len .GT. 0) then
            dnode = KXGDNO(ENV(1), 1, -1)
            type = 255+dnode
            status = KXWRIT(send_buff, len*doubleSize, dnode, type)
            unode = KXGDNO(ENV(1), 1, 1)
            type = 255+ENV(1)
            status = KXREAD(rec_buff,len*doubleSize,unode, type)
            
            len = 1
            if (coord(2) .EQ. (nproc(2) -1)) then
               do i = lb2, ub2
                  if (direc(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(lb1+k,i)=bound(i)
                     end do
                  end if
               end do
            else
               do i = lb2, ub2
                  if (direc(i) .GT. 0) then
                     do k = 0, shift(i) -1
                        array(lb1+k,i)=rec_buff(len)
                        len = len + 1
                     end do
                  end if
               end do
            end if
         end if
      end if
      
      return
      end





