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 findintsum(v1, v2, size)
      integer v1, v2, size

      v1 = v1 + v2
      findintsum = 0

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      real function findrealsum(v1, v2, size)
      integer size
      real v1, v2

      v1 = v1 + v2
      findrealsum = 0.0

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      double precision function finddoublesum(v1, v2, size)
      integer size
      double precision v1, v2

      v1 = v1 + v2
      finddoublesum = 0.0

      return
      end




CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC




      integer function findintprod(v1, v2, size)
      integer v1, v2, size

      v1 = v1 * v2
      findintprod = 1

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      real function findrealprod(v1, v2, size)
      integer size
      real v1, v2

      v1 = v1 * v2
      findrealprod = 1.0

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      double precision function finddoubleprod(v1, v2, size)
      integer size
      double precision v1, v2

      v1 = v1 * v2
      finddoubleprod = 1.0

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine LOC_TO_GLOB_1(A_INFO, loc, glob)
      integer A_INFO(8,7), loc, glob
      integer status, env(4), nproc(2), myno, coord(2), k

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

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

      if (A_INFO(6,1) .EQ. 0) then
         glob = loc
      end if

      if (A_INFO(6,1) .EQ. 1) then
         glob = loc + k*(A_INFO(2,1) - A_INFO(1,1) + 1)
      end if

      if (A_INFO(6,1) .EQ. 2) then
         glob = (loc-1)*env(2) + k + 1
      end if

      if (A_INFO(6,1) .EQ. 3) then
         glob = MOD(loc-1,A_INFO(7,1)) + 1 + ((loc-1)/size*env(2) + 
     &          k)*size
      end if

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine LOC_TO_GLOB_2(A_INFO, loc, glob)
      integer A_INFO(8,7), loc(2), glob(2)
      integer status, env(4), myno, coord(2), size(2), nproc(2)
      integer x, y, m, n
      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC

      nproc(2) = A_INFO(8,1)
      nproc(1) = A_INFO(8,2)
      status = KXPARA(env)
      myno = env(1)
      status = KXGDIN(2, nproc)
      status = KXGDCO(myno, coord)
      x = coord(1)
      y = coord(2)
      m = A_INFO(2,1) - A_INFO(1,1) + 1
      n = A_INFO(2,2) - A_INFO(1,2) + 1

      size(1) = A_INFO(7,1)
      size(2) = A_INFO(7,2)
      if (A_INFO(6,1) .EQ. 0) then
         glob(1) = loc(1)
      end if 

      if (A_INFO(6,1) .EQ. 1) then
         glob(1) = loc(1) + y*m
      end if

      if (A_INFO(6,1) .EQ. 2) then
         glob(1) = (loc(1)-1)*nproc(2) + y + 1
      end if

      if (A_INFO(6,1) .EQ. 3) then
         glob(1) = MOD(loc(1)-1,size(1)) + 1 + ((loc(1)-1)/
     &        size(1)*nproc(2) + y)*size(1)
      end if   


      if (A_INFO(6,2) .EQ. 0) then
         glob(2) = loc(2)
      end if 

      if (A_INFO(6,2) .EQ. 1) then
         glob(2) = loc(2) + x*n
      end if
      
      if (A_INFO(6,2) .EQ. 2) then
         glob(2) = (loc(2)-1)*nproc(1) + x + 1
      end if

      if (A_INFO(6,2) .EQ. 3) then
         glob(2) = MOD(loc(2)-1,size(2)) + 1 + ((loc(2)-1)/
     &        size(2)*nproc(1) + x)*size(2)
      end if

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      integer function findintmax1(v1, v2, size)
      integer v1(2), v2(2), size
      
      if (v2(1) .GT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
      end if

      if ((v2(1) .EQ. v1(1)) .AND. (v1(2) .GT. v2(2))) then
         v1(2) = v2(2)
      end if
         
      findintmax1 = 0

      return
      end


      
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      integer function findintmax2(v1, v2, size)
      integer v1(3), v2(3), size

      if (v2(1) .GT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
         v1(3) = v2(3)
      end if
      
      if (v1(1) .EQ. v2(1)) then
         if (v1(3) .GT. v2(3)) then
            v1(2) = v2(2)
            v1(3) = v2(3)
         end if
         if ((v1(3) .EQ. v2(3)) .AND. (v1(2) .GT. v2(2))) then
            v1(2) = v2(2)
         end if
      end if

      findintmax2 = 0

      return
      end
      


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  


      real function findrealmax1(v1, v2, size)
      real v1(2), v2(2)
      integer size
      
      if (v2(1) .GT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
      end if

      if ((v2(1) .EQ. v1(1)) .AND. (v1(2) .GT. v2(2))) then
         v1(2) = v2(2)
      end if
         
      findrealmax1 = 0.0

      return
      end


      
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      real function findrealmax2(v1, v2, size)
      real v1(3), v2(3)
      integer size

      if (v2(1) .GT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
         v1(3) = v2(3)
      end if
      
      if (v1(1) .EQ. v2(1)) then
         if (v1(3) .GT. v2(3)) then
            v1(2) = v2(2)
            v1(3) = v2(3)
         end if
         if ((v1(3) .EQ. v2(3)) .AND. (v1(2) .GT. v2(2))) then
            v1(2) = v2(2)
         end if
      end if

      findrealmax2 = 0.0

      return
      end
      


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  


      double precision function finddoublemax1(v1, v2, size)
      double precision v1(2), v2(2)
      integer size
      
      if (v2(1) .GT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
      end if

      if ((v2(1) .EQ. v1(1)) .AND. (v1(2) .GT. v2(2))) then
         v1(2) = v2(2)
      end if
         
      finddoublemax1 = 0.0

      return
      end


      
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      double precision function finddoublemax2(v1, v2, size)
      double precision v1(3), v2(3)
      integer size

      if (v2(1) .GT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
         v1(3) = v2(3)
      end if
      
      if (v1(1) .EQ. v2(1)) then
         if (v1(3) .GT. v2(3)) then
            v1(2) = v2(2)
            v1(3) = v2(3)
         end if
         if ((v1(3) .EQ. v2(3)) .AND. (v1(2) .GT. v2(2))) then
            v1(2) = v2(2)
         end if
      end if

      finddoublemax2 = 0.0

      return
      end
      





CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      

      integer function findintmax(v1, v2, size)
      integer v1, v2, size
      
      if (v2 .GT. v1) then
         v1 = v2
      end if

      findintmax = 0

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      real function findrealmax(v1, v2, size)
      real v1, v2
      integer size
      
      if (v2 .GT. v1) then
         v1= v2
      end if

      findrealmax = 0.0

      return
      end
      


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      double precision function finddoublemax(v1, v2, size)
      double precision v1, v2
      integer size
      
      if (v2 .GT. v1) then
         v1= v2
      end if

      finddoublemax = 0.0

      return
      end
      


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      

      integer function findintmin(v1, v2, size)
      integer v1, v2, size
      
      if (v2 .LT. v1) then
         v1 = v2
      end if

      findintmin = 0

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      real function findrealmin(v1, v2, size)
      real v1, v2
      integer size
      
      if (v2 .LT. v1) then
         v1= v2
      end if

      findrealmin = 0.0

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      double precision function finddoublemin(v1, v2, size)
      double precision v1, v2
      integer size
      
      if (v2 .LT. v1) then
         v1= v2
      end if

      finddoublemin = 0.0

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      integer function findintmin1(v1, v2, size)
      integer v1(2), v2(2), size
      
      if (v2(1) .LT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
      end if

      if ((v2(1) .EQ. v1(1)) .AND. (v1(2) .GT. v2(2))) then
         v1(2) = v2(2)
      end if
         
      findintmin1 = 0

      return
      end


      
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      integer function findintmin2(v1, v2, size)
      integer v1(3), v2(3), size

      if (v2(1) .LT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
         v1(3) = v2(3)
      end if
      
      if (v1(1) .EQ. v2(1)) then
         if (v1(3) .GT. v2(3)) then
            v1(2) = v2(2)
            v1(3) = v2(3)
         end if
         if ((v1(3) .EQ. v2(3)) .AND. (v1(2) .GT. v2(2))) then
            v1(2) = v2(2)
         end if
      end if

      findintmin2 = 0

      return
      end
      


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  


      real function findrealmin1(v1, v2, size)
      real v1(2), v2(2)
      integer size
      
      if (v2(1) .LT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
      end if

      if ((v2(1) .EQ. v1(1)) .AND. (v1(2) .GT. v2(2))) then
         v1(2) = v2(2)
      end if
         
      findrealmin1 = 0.0

      return
      end


      
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      real function findrealmin2(v1, v2, size)
      real v1(3), v2(3)
      integer size

      if (v2(1) .LT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
         v1(3) = v2(3)
      end if
      
      if (v1(1) .EQ. v2(1)) then
         if (v1(3) .GT. v2(3)) then
            v1(2) = v2(2)
            v1(3) = v2(3)
         end if
         if ((v1(3) .EQ. v2(3)) .AND. (v1(2) .GT. v2(2))) then
            v1(2) = v2(2)
         end if
      end if

      findrealmin2 = 0.0

      return
      end
      


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  


      double precision function finddoublemin1(v1, v2, size)
      double precision v1(2), v2(2)
      integer size
      
      if (v2(1) .LT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
      end if

      if ((v2(1) .EQ. v1(1)) .AND. (v1(2) .GT. v2(2))) then
         v1(2) = v2(2)
      end if
         
      finddoublemin1 = 0.0

      return
      end


      
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  



      double precision function finddoublemin2(v1, v2, size)
      double precision v1(3), v2(3)
      integer size

      if (v2(1) .LT. v1(1)) then
         v1(1) = v2(1)
         v1(2) = v2(2)
         v1(3) = v2(3)
      end if
      
      if (v1(1) .EQ. v2(1)) then
         if (v1(3) .GT. v2(3)) then
            v1(2) = v2(2)
            v1(3) = v2(3)
         end if
         if ((v1(3) .EQ. v2(3)) .AND. (v1(2) .GT. v2(2))) then
            v1(2) = v2(2)
         end if
      end if

      finddoublemin2 = 0.0

      return
      end
      




CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      logical function findand(v1, v2, size)
      logical v1, v2
      integer size
      
      v1 = v1 .AND. v2

      findand = .TRUE.

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      
      logical function findor(v1, v2, size)
      logical v1, v2
      integer size
      
      v1 = v1 .OR. v2

      findor = .TRUE.

      return
      end
      

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC



      complex function findcompsum(v1, v2, size)
      complex v1, v2
      integer size
      
      v1 = v1 + v2

      findcompsum = (0.0,0.0)

      return
      end
      


