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


      integer function SUM_1_I(A, a1, a2, A_INFO, proclist)
      integer a1, a2
      integer A(a1:a2), A_INFO(8,7), sum, proclist(*)
      integer i, intsize, type, status, min_row, max_row
      data intsize, type /4, 23/
      integer findintsum
      external findintsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      sum = 0

      do i=min_row, max_row
         sum = sum + A(i)
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findintsum,intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findintsum,intsize,1,proclist(1),
     &                  proclist(2),type)
      end if
      
      SUM_1_I = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      integer function SUM_1_I_M(A, a1, a2, A_INFO, mask, m1, m2, 
     &        MASK_INFO, proclist)
      integer a1, a2, m1, m2, A_INFO(8,7), sum, proclist(*)
      integer A(a1:a2), MASK_INFO(8,7)
      logical mask(m1:m2)
      integer i, intsize, type, status, min_row, max_row
      data intsize, type /4, 23/
      integer findintsum
      external findintsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      sum = 0

      do i=min_row, max_row
         if (mask(i)) then
            sum = sum + A(i)
         end if
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findintsum,intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findintsum,intsize,1,proclist(1),
     &                   proclist(2),type)
      end if

      SUM_1_I_M = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      integer function SUM_2_I_S(A, a1, a2, a3, a4, A_INFO, 
     &       proclist)
      integer a1, a2, a3, a4, A_INFO(8,7), sum, proclist(*)
      integer A(a1:a2,a3:a4)
      integer min_row, max_row, min_col, max_col
      integer i, intsize, type, status
      data intsize, type /4, 23/
      integer findintsum
      external findintsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      sum = 0
      do j=min_col, max_col
         do i=min_row, max_row
            sum = sum + A(i,j)
         end do
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findintsum,intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findintsum,intsize,1,proclist(1),
     &                    proclist(2),type)
      end if

      SUM_2_I_S = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      integer function SUM_2_I_S_M(A, a1, a2, a3, a4, A_INFO, mask, 
     &   m1, m2, m3, m4, MASK_INFO, proclist)
      integer a1, a2, a3, a4, m1, m2, m3, m4
      integer A_INFO(8,7), MASK_INFO(8,7)
      integer A(a1:a2,a3:a4), sum, proclist(*)
      logical mask(m1:m2,m3:m4)
      integer min_row, max_row, min_col, max_col
      integer i, intsize, type, status
      data intsize, type /4, 23/
      integer findintsum
      external findintsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      sum = 0
      do j=min_col, max_col
         do i=min_row, max_row
            if (mask(i,j)) then
               sum = sum + A(i,j)
            end if
         end do
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findintsum,intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findintsum,intsize,1,proclist(1),
     &                    proclist(2),type)
      end if

      SUM_2_I_S_M = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      subroutine SUM_2_I_V(A, a1, a2, a3, a4, A_INFO, dim, sum, 
     &   s1, s2, SUM_INFO, proclist)
      integer a1, a2, a3, a4, s1, s2, A_INFO(8,7), SUM_INFO(8,7)
      integer A(a1:a2,a3:a4), dim, sum(s1:s2), proclist(*)
      integer i, j, status, min_row, max_row, min_col, max_col
      integer intsize, type
      data intsize, type /4, 23/
      integer env(4), coord(2), nproc(2), size
      integer findintsum
      external findintsum

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

      
      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      if (dim .EQ. 2) then 
         size = max_row - min_row + 1
      else 
         size = max_col - min_col + 1
      end if

      if (dim .EQ. 2) then
         do i=min_row, max_row
            sum(i) = A(i,min_col)
            do j=min_col+1, max_col
               sum(i) = sum(i) + A(i,j)
            end do
         end do
      else
         do i=min_col, max_col
            sum(i) = A(min_row,i)
            do j=min_row+1, max_row
               sum(i) = sum(i) + A(j,i)
            end do
         end do
      end if


C     (BLOCK,*), (CYCLIC,*) AND REDUCTION ALONG COLUMN;   OR 
C     (*,BLOCK), (*,CYCLIC) AND REDUCTION ALONG ROW.


      if (((A_INFO(6,2) .EQ. 0) .AND. (dim .EQ. 1)) .OR. 
     & ((A_INFO(6,1) .EQ. 0) .AND. (dim .EQ. 2))) then
         nproc(1) = A_INFO(8,dim)
         status = KXGDIN(1, nproc)
         status = KXCOMB(sum,findintsum,intsize,size,IALNOD,0,type)
      end if


C     ARRAY DECOMPOSED ALONG BOTH DIMENSIONS


      if ((A_INFO(6,1) .NE. 0) .AND. (A_INFO(6,2) .NE. 0)) then
         nproc(2) = A_INFO(8,1)
         nproc(1) = A_INFO(8,2)

         status = KXPARA(env)
         status = KXGDIN(2, nproc)
         status = KXGDCO(env(1), coord)

         if (dim .EQ. 2) then
            do i=0, nproc(1)-1
               coord(1) = i
               proclist(i+1) = KXGDPR(coord)
            end do
         else
            do i=0, nproc(2)-1
               coord(2) = i
               proclist(i+1) = KXGDPR(coord)
            end do 
         endif
         
         status = KXCOMB(sum,findintsum,intsize,size,nproc(3-dim),
     &   proclist, type)
      end if

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine SUM_2_I_V_M(A, a1, a2, a3, a4, A_INFO, dim, mask, 
     &  m1, m2, m3, m4, MASK_INFO, sum, s1, s2, SUM_INFO, proclist)
      integer a1, a2, a3, a4, m1, m2, m3, m4, s1, s2
      integer A_INFO(8,7), MASK_INFO(8,7), SUM_INFO(8,7) 
      integer A(a1:a2,a3:a4), dim, sum(s1:s2), proclist(*)
      logical mask(m1:m2,m3:m4)
      integer i, j, status, min_row, max_row, min_col, max_col
      integer intsize, type
      data intsize, type /4, 23/
      integer env(4), coord(2), nproc(2), size
      integer findintsum
      external findintsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      if (dim .EQ. 2) then 
         size = max_row - min_row + 1
      else 
         size = max_col - min_col + 1
      end if

      if (dim .EQ. 2) then
         do i=min_row, max_row
            sum(i) = 0
            do j=min_col, max_col
               if (mask(i,j)) then
                  sum(i) = sum(i) + A(i,j)
               end if
            end do
         end do
      else
         do i=min_col, max_col
            sum(i) = 0
            do j=min_row, max_row
               if (mask(j,i)) then
                  sum(i) = sum(i) + A(j,i)
               end if
            end do
         end do
      end if


C     (BLOCK,*), (CYCLIC,*) AND REDUCTION ALONG COLUMN;   OR 
C     (*,BLOCK), (*,CYCLIC) AND REDUCTION ALONG ROW.


      if (((A_INFO(6,2) .EQ. 0) .AND. (dim .EQ. 1)) .OR. 
     & ((A_INFO(6,1) .EQ. 0) .AND. (dim .EQ. 2))) then
         nproc(1) = A_INFO(8,dim)
         status = KXGDIN(1, nproc)
         status = KXCOMB(sum,findintsum,intsize,size,IALNOD,0,type)
      end if


C     ARRAY DECOMPOSED ALONG BOTH DIMENSIONS


      if ((A_INFO(6,1) .NE. 0) .AND. (A_INFO(6,2) .NE. 0)) then
         nproc(2) = A_INFO(8,1)
         nproc(1) = A_INFO(8,2)

         status = KXPARA(env)
         status = KXGDIN(2, nproc)
         status = KXGDCO(env(1), coord)

         if (dim .EQ. 2) then
            do i=0, nproc(1)-1
               coord(1) = i
               proclist(i+1) = KXGDPR(coord)
            end do
         else
            do i=0, nproc(2)-1
               coord(2) = i
               proclist(i+1) = KXGDPR(coord)
            end do 
         endif
         
         status = KXCOMB(sum,findintsum,intsize,size,nproc(3-dim),
     &   proclist, type)
      end if

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC




C    FOR  REAL 



      real function SUM_1_R_S(A, a1, a2, A_INFO, proclist)
      integer a1, a2, A_INFO(8,7), proclist(*)
      real A(a1:a2), sum
      integer i, realsize, type, status, min_row, max_row
      data realsize, type /4, 23/
      real findrealsum
      external findrealsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      sum = 0.0

      do i=min_row, max_row
         sum = sum + A(i)
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findrealsum,realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findrealsum,realsize,1,proclist(1),
     &                  proclist(2),type)
      end if

      SUM_1_R_S = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      real function SUM_1_R_M(A, a1, a2, A_INFO, mask, m1, m2, 
     &        MASK_INFO, proclist)
      integer a1, a2, m1, m2, A_INFO(8,7), MASK_INFO(8,7)
      integer proclist(*)
      real A(a1:a2), sum
      logical mask(m1:m2)
      integer i, realsize, type, status, min_row, max_row
      data realsize, type /4, 23/
      real findrealsum
      external findrealsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      sum = 0.0

      do i=min_row, max_row
         if (mask(i)) then
            sum = sum + A(i)
         end if
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findrealsum,realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findrealsum,realsize,1,proclist(1),
     &                   proclist(2),type)
      end if

      SUM_1_R_M = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      real function SUM_2_R_S(A, a1, a2, a3, a4, A_INFO, proclist)
      integer a1, a2, a3, a4, A_INFO(8,7), proclist(*)
      real A(a1:a2,a3:a4), sum
      integer min_row, max_row, min_col, max_col
      integer i, realsize, type, status
      data realsize, type /4, 23/
      real findrealsum
      external findrealsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      sum = 0.0
      do j=min_col, max_col
         do i=min_row, max_row
            sum = sum + A(i,j)
         end do
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findrealsum,realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findrealsum,realsize,1,proclist(1),
     &                    proclist(2),type)
      end if

      SUM_2_R_S = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      real function SUM_2_R_S_M(A, a1, a2, a3, a4, A_INFO, mask, 
     &   m1, m2, m3, m4, MASK_INFO, proclist)
      integer a1, a2, a3, a4, m1, m2, m3, m4
      integer A_INFO(8,7), MASK_INFO(8,7), proclist(*)
      real A(a1:a2,a3:a4), sum
      logical mask(m1:m2,m3:m4)
      integer min_row, max_row, min_col, max_col
      integer i, realsize, type, status
      data realsize, type /4, 23/
      real findrealsum
      external findrealsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      sum = 0.0
      do j=min_col, max_col
         do i=min_row, max_row
            if (mask(i,j)) then
               sum = sum + A(i,j)
            end if
         end do
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,findrealsum,realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,findrealsum,realsize,1,proclist(1),
     &                    proclist(2),type)
      end if

      SUM_2_R_S_M = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      subroutine SUM_2_R_V(A, a1, a2, a3, a4, A_INFO, dim, sum, 
     &   s1, s2, SUM_INFO, proclist)
      integer a1, a2, a3, a4, s1, s2, A_INFO(8,7), SUM_INFO(8,7)
      real A(a1:a2,a3:a4), sum(s1:s2)
      integer dim, proclist(*)
      integer i, j, status, min_row, max_row, min_col, max_col
      integer realsize, type
      data realsize, type /4, 23/
      integer env(4), coord(2), nproc(2), size
      real findrealsum
      external findrealsum

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

      
      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      if (dim .EQ. 2) then 
         size = max_row - min_row + 1
      else 
         size = max_col - min_col + 1
      end if

      if (dim .EQ. 2) then
         do i=min_row, max_row
            sum(i) = A(i,min_col)
            do j=min_col+1, max_col
               sum(i) = sum(i) + A(i,j)
            end do
         end do
      else
         do i=min_col, max_col
            sum(i) = A(min_row,i)
            do j=min_row+1, max_row
               sum(i) = sum(i) + A(j,i)
            end do
         end do
      end if


C     (BLOCK,*), (CYCLIC,*) AND REDUCTION ALONG COLUMN;   OR 
C     (*,BLOCK), (*,CYCLIC) AND REDUCTION ALONG ROW.


      if (((A_INFO(6,2) .EQ. 0) .AND. (dim .EQ. 1)) .OR. 
     & ((A_INFO(6,1) .EQ. 0) .AND. (dim .EQ. 2))) then
         nproc(1) = A_INFO(8,dim)
         status = KXGDIN(1, nproc)
         status = KXCOMB(sum,findrealsum,realsize,size,IALNOD,0,type)
      end if


C     ARRAY DECOMPOSED ALONG BOTH DIMENSIONS


      if ((A_INFO(6,1) .NE. 0) .AND. (A_INFO(6,2) .NE. 0)) then
         nproc(2) = A_INFO(8,1)
         nproc(1) = A_INFO(8,2)

         status = KXPARA(env)
         status = KXGDIN(2, nproc)
         status = KXGDCO(env(1), coord)

         if (dim .EQ. 2) then
            do i=0, nproc(1)-1
               coord(1) = i
               proclist(i+1) = KXGDPR(coord)
            end do
         else
            do i=0, nproc(2)-1
               coord(2) = i
               proclist(i+1) = KXGDPR(coord)
            end do 
         endif
         
         status = KXCOMB(sum,findrealsum,realsize,size,nproc(3-dim),
     &   proclist, type)
      end if

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine SUM_2_R_V_M(A, a1, a2, a3, a4, A_INFO, dim, mask, 
     &  m1, m2, m3, m4, MASK_INFO, sum, s1, s2, SUM_INFO, proclist)
      integer a1, a2, a3, a4, m1, m2, m3, m4, s1, s2
      integer A_INFO(8,7), MASK_INFO(8,7), SUM_INFO(8,7) 
      real A(a1:a2,a3:a4), sum(s1:s2)
      integer dim, proclist(*)
      logical mask(m1:m2,m3:m4)
      integer i, j, status, min_row, max_row, min_col, max_col
      integer realsize, type
      data realsize, type /4, 23/
      integer env(4), coord(2), nproc(2), size
      real findrealsum
      external findrealsum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      if (dim .EQ. 2) then 
         size = max_row - min_row + 1
      else 
         size = max_col - min_col + 1
      end if

      if (dim .EQ. 2) then
         do i=min_row, max_row
            sum(i) = 0.0
            do j=min_col, max_col
               if (mask(i,j)) then
                  sum(i) = sum(i) + A(i,j)
               end if
            end do
         end do
      else
         do i=min_col, max_col
            sum(i) = 0.0
            do j=min_row, max_row
               if (mask(j,i)) then
                  sum(i) = sum(i) + A(j,i)
               end if
            end do
         end do
      end if


C     (BLOCK,*), (CYCLIC,*) AND REDUCTION ALONG COLUMN;   OR 
C     (*,BLOCK), (*,CYCLIC) AND REDUCTION ALONG ROW.


      if (((A_INFO(6,2) .EQ. 0) .AND. (dim .EQ. 1)) .OR. 
     & ((A_INFO(6,1) .EQ. 0) .AND. (dim .EQ. 2))) then
         nproc(1) = A_INFO(8,dim)
         status = KXGDIN(1, nproc)
         status = KXCOMB(sum,findrealsum,realsize,size,IALNOD,0,type)
      end if


C     ARRAY DECOMPOSED ALONG BOTH DIMENSIONS


      if ((A_INFO(6,1) .NE. 0) .AND. (A_INFO(6,2) .NE. 0)) then
         nproc(2) = A_INFO(8,1)
         nproc(1) = A_INFO(8,2)

         status = KXPARA(env)
         status = KXGDIN(2, nproc)
         status = KXGDCO(env(1), coord)

         if (dim .EQ. 2) then
            do i=0, nproc(1)-1
               coord(1) = i
               proclist(i+1) = KXGDPR(coord)
            end do
         else
            do i=0, nproc(2)-1
               coord(2) = i
               proclist(i+1) = KXGDPR(coord)
            end do 
         endif
         
         status = KXCOMB(sum,findrealsum,realsize,size,nproc(3-dim),
     &   proclist, type)
      end if

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC




C    FOR  DOUBLE 



      double precision function SUM_1_D(A, a1, a2, A_INFO, proclist)
      integer a1, a2, A_INFO(8,7), proclist(*)
      double precision A(a1:a2), sum
      integer i, doublesize, type, status, min_row, max_row
      data doublesize, type /8, 23/
      double precision finddoublesum
      external finddoublesum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      sum = 0.0

      do i=min_row, max_row
         sum = sum + A(i)
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,finddoublesum,doublesize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,finddoublesum,doublesize,1,proclist(1),
     &                  proclist(2),type)
      end if

      SUM_1_D = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      double precision function SUM_1_D_M(A, a1, a2, A_INFO, mask, 
     &        m1, m2, MASK_INFO, proclist)
      integer a1, a2, m1, m2, A_INFO(8,7), MASK_INFO(8,7)
      integer proclist(*)
      double precision A(a1:a2), sum
      logical mask(m1:m2)
      integer i, doublesize, type, status, min_row, max_row
      data doublesize, type /8, 23/
      double precision finddoublesum
      external finddoublesum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      sum = 0.0

      do i=min_row, max_row
         if (mask(i)) then
            sum = sum + A(i)
         end if
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,finddoublesum,doublesize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,finddoublesum,doublesize,1,proclist(1),
     &                   proclist(2),type)
      end if

      SUM_1_D_M = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      double precision function SUM_2_D_S(A, a1, a2, a3, a4, A_INFO,
     &        proclist)
      integer a1, a2, a3, a4, A_INFO(8,7), proclist(*)
      double precision A(a1:a2,a3:a4), sum
      integer min_row, max_row, min_col, max_col
      integer i, doublesize, type, status
      data doublesize, type /8, 23/
      double precision finddoublesum
      external finddoublesum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      sum = 0.0
      do j=min_col, max_col
         do i=min_row, max_row
            sum = sum + A(i,j)
         end do
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,finddoublesum,doublesize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,finddoublesum,doublesize,1,proclist(1),
     &                    proclist(2),type)
      end if

      SUM_2_D_S = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      double precision function SUM_2_D_S_M(A, a1, a2, a3, a4, 
     &   A_INFO, mask, m1, m2, m3, m4, MASK_INFO, proclist)
      integer a1, a2, a3, a4, m1, m2, m3, m4
      integer A_INFO(8,7), MASK_INFO(8,7), proclist(*)
      double precision A(a1:a2,a3:a4), sum
      logical mask(m1:m2,m3:m4)
      integer min_row, max_row, min_col, max_col
      integer i, doublesize, type, status
      data doublesize, type /8, 23/
      double precision finddoublesum
      external finddoublesum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      sum = 0.0
      do j=min_col, max_col
         do i=min_row, max_row
            if (mask(i,j)) then
               sum = sum + A(i,j)
            end if
         end do
      end do

      if (proclist(1) .EQ. -1) then
         status = KXCOMB(sum,finddoublesum,doublesize,1,IALNOD,0,type)
      else
         status = KXCOMB(sum,finddoublesum,doublesize,1,proclist(1),
     &                    proclist(2),type)
      end if

      SUM_2_D_S_M = sum

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      subroutine SUM_2_D_V(A, a1, a2, a3, a4, A_INFO, dim, sum, 
     &   s1, s2, SUM_INFO, proclist)
      integer a1, a2, a3, a4, s1, s2, A_INFO(8,7), SUM_INFO(8,7)
      double precision A(a1:a2,a3:a4), sum(s1:s2)
      integer dim, proclist(*)
      integer i, j, status, min_row, max_row, min_col, max_col
      integer doublesize, type
      data doublesize, type /8, 23/
      integer env(4), coord(2), nproc(2), size
      double precision finddoublesum
      external finddoublesum

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

      
      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      if (dim .EQ. 2) then 
         size = max_row - min_row + 1
      else 
         size = max_col - min_col + 1
      end if

      if (dim .EQ. 2) then
         do i=min_row, max_row
            sum(i) = A(i,min_col)
            do j=min_col+1, max_col
               sum(i) = sum(i) + A(i,j)
            end do
         end do
      else
         do i=min_col, max_col
            sum(i) = A(min_row,i)
            do j=min_row+1, max_row
               sum(i) = sum(i) + A(j,i)
            end do
         end do
      end if


C     (BLOCK,*), (CYCLIC,*) AND REDUCTION ALONG COLUMN;   OR 
C     (*,BLOCK), (*,CYCLIC) AND REDUCTION ALONG ROW.


      if (((A_INFO(6,2) .EQ. 0) .AND. (dim .EQ. 1)) .OR. 
     & ((A_INFO(6,1) .EQ. 0) .AND. (dim .EQ. 2))) then
         nproc(1) = A_INFO(8,dim)
         status = KXGDIN(1, nproc)
         status = KXCOMB(sum,finddoublesum,doublesize,size,IALNOD,0,
     &       type)
      end if


C     ARRAY DECOMPOSED ALONG BOTH DIMENSIONS


      if ((A_INFO(6,1) .NE. 0) .AND. (A_INFO(6,2) .NE. 0)) then
         nproc(2) = A_INFO(8,1)
         nproc(1) = A_INFO(8,2)

         status = KXPARA(env)
         status = KXGDIN(2, nproc)
         status = KXGDCO(env(1), coord)

         if (dim .EQ. 2) then
            do i=0, nproc(1)-1
               coord(1) = i
               proclist(i+1) = KXGDPR(coord)
            end do
         else
            do i=0, nproc(2)-1
               coord(2) = i
               proclist(i+1) = KXGDPR(coord)
            end do 
         endif
         
         status = KXCOMB(sum,finddoublesum,doublesize,size,
     &   nproc(3-dim),proclist, type)
      end if

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine SUM_2_D_V_M(A, a1, a2, a3, a4, A_INFO, dim, mask, 
     &  m1, m2, m3, m4, MASK_INFO, sum, s1, s2, SUM_INFO, proclist)
      integer a1, a2, a3, a4, m1, m2, m3, m4, s1, s2
      integer A_INFO(8,7), MASK_INFO(8,7), SUM_INFO(8,7) 
      double precision A(a1:a2,a3:a4), sum(s1:s2)
      integer dim, proclist(*)
      logical mask(m1:m2,m3:m4)
      integer i, j, status, min_row, max_row, min_col, max_col
      integer doublesize, type
      data doublesize, type /8, 23/
      integer env(4), coord(2), nproc(2), size
      double precision finddoublesum
      external finddoublesum

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

      min_row = A_INFO(1,1)
      max_row = A_INFO(2,1)
      min_col = A_INFO(1,2)
      max_col = A_INFO(2,2)

      if (dim .EQ. 2) then 
         size = max_row - min_row + 1
      else 
         size = max_col - min_col + 1
      end if

      if (dim .EQ. 2) then
         do i=min_row, max_row
            sum(i) = 0.0
            do j=min_col, max_col
               if (mask(i,j)) then
                  sum(i) = sum(i) + A(i,j)
               end if
            end do
         end do
      else
         do i=min_col, max_col
            sum(i) = 0.0
            do j=min_row, max_row
               if (mask(j,i)) then
                  sum(i) = sum(i) + A(j,i)
               end if
            end do
         end do
      end if


C     (BLOCK,*), (CYCLIC,*) AND REDUCTION ALONG COLUMN;   OR 
C     (*,BLOCK), (*,CYCLIC) AND REDUCTION ALONG ROW.


      if (((A_INFO(6,2) .EQ. 0) .AND. (dim .EQ. 1)) .OR. 
     & ((A_INFO(6,1) .EQ. 0) .AND. (dim .EQ. 2))) then
         nproc(1) = A_INFO(8,dim)
         status = KXGDIN(1, nproc)
         status = KXCOMB(sum,finddoublesum,doublesize,size,IALNOD,0,
     &       type)
      end if


C     ARRAY DECOMPOSED ALONG BOTH DIMENSIONS


      if ((A_INFO(6,1) .NE. 0) .AND. (A_INFO(6,2) .NE. 0)) then
         nproc(2) = A_INFO(8,1)
         nproc(1) = A_INFO(8,2)

         status = KXPARA(env)
         status = KXGDIN(2, nproc)
         status = KXGDCO(env(1), coord)

         if (dim .EQ. 2) then
            do i=0, nproc(1)-1
               coord(1) = i
               proclist(i+1) = KXGDPR(coord)
            end do
         else
            do i=0, nproc(2)-1
               coord(2) = i
               proclist(i+1) = KXGDPR(coord)
            end do 
         endif
         
         status = KXCOMB(sum,finddoublesum,doublesize,size,
     &   nproc(3-dim),proclist, type)
      end if

      return
      end







