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 COUNT_1_L(A, a1, a2, A_INFO, proclist)
      integer a1, a2, A_INFO(8,7), proclist(*)
      logical A(a1:a2)
      integer local
      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)
      local = 0

      do i=min_row, max_row
         if (A(i)) then
            local = local + 1
         end if
      end do

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

      COUNT_1_L = local

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      integer function COUNT_2_L_S(A, a1, a2, a3, a4, A_INFO, 
     &       proclist)
      integer a1, a2, a3, a4, A_INFO(8,7), proclist(*)
      logical A(a1:a2,a3:a4)
      integer min_row, max_row, min_col, max_col, local
      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)

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

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

      COUNT_2_L_S = local

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine COUNT_2_L_V(A, a1, a2, a3, a4, A_INFO, dim, local, 
     &   s1, s2, LOCAL_INFO, proclist)
      integer a1, a2, a3, a4, s1, s2, A_INFO(8,7), LOCAL_INFO(8,7)
      logical A(a1:a2,a3:a4)
      integer dim, proclist(*), local(s1:s2)
      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
            local(i) = 0
            do j=min_col+1, max_col
               if (A(i,j)) then
                  local(i) = local(i) + 1
               end if
            end do
         end do
      else
         do i=min_col, max_col
            local(i) = 0
            do j=min_row+1, max_row
               if (A(j,i)) then
                  local(i) = local(i) + 1
               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(local,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(local,findintsum,intsize,size,nproc(3-dim),
     &   proclist, type)
      end if

      return
      end


