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


      subroutine MINLOC_1_I(A, a1, a2, A_INFO, glob, g1, g2, 
     &       GLOB_INFO, proclist)

C     glob = GLOBAL index
      
      integer a1, a2, g1, g2, GLOB_INFO(8,7)
      integer A(a1:a2), A_INFO(8,7), glob(g1:g2), proclist(*)
      integer i, status, min_row, max_row, loc, min(2)
      integer intsize, type
      data intsize, type /4, 23/
      integer findintmin1
      external findintmin1

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

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

      min(1) = A(min_row)
      loc = min_row

      do i=min_row+1, max_row
         if (A(i) .LT. min(1)) then
            min(1) = A(i)
            loc = i
         end if
      end do
      
      call LOC_TO_GLOB_1(A_INFO, loc, i)
      min(2) = i
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findintmin1,2*intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findintmin1,2*intsize,1,proclist(1),
     &                 proclist(2),type)
      end if         
      glob(1) = min(2)

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_1_I_M(A, a1, a2, A_INFO, mask, m1, m2, 
     &        MASK_INFO, glob, g1, g2, GLOB_INFO, proclist)

C     glob = GLOBAL index

      integer a1, a2, g1, g2, m1, m2, GLOB_INFO(8,7), MASK_INFO(8,7)
      integer A(a1:a2), A_INFO(8,7), glob(g1:g2), proclist(*)
      logical mask(m1:m2)
      integer i, status, min_row, max_row, loc, min(2)
      integer intsize, type
      data intsize, type /4, 23/
      integer findintmin1
      external findintmin1

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

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

      min(1) = 2147483647

      do i=min_row, max_row
         if ((A(i) .LT. min(1)) .AND. mask(i)) then
            min(1) = A(i)
            loc = i
         end if
      end do
      
      call LOC_TO_GLOB_1(A_INFO, loc, i)
      min(2) = i
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findintmin1,2*intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findintmin1,2*intsize,1,proclist(1),
     &                   proclist(2),type)
      end if
      glob(1) = min(2)

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_2_I(A, a1, a2, a3, a4, A_INFO, glob, g1, g2, 
     &   GLOB_INFO, proclist)

C     glob(1), glob(2) = GLOBAL index

      integer a1, a2, a3, a4, g1, g2
      integer A(a1:a2,a3:a4), glob(g1:g2)
      integer A_INFO(8,7), proclist(*), GLOB_INFO(8,7)
      integer i, j, min(3), loc(2)
      integer status, min_row, max_row, min_col, max_col
      integer intsize, type
      data intsize, type /4, 23/
      integer findintmin2
      external findintmin2

      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)

      min(1) = A(min_row,min_col)
      loc(1) = min_row
      loc(2) = min_col
      do j=min_col, max_col
         do i=min_row, max_row
            if (A(i,j) .LT. min(1)) then
               min(1) = A(i,j)
               loc(1) = i
               loc(2) = j
            end if
         end do
      end do

      call LOC_TO_GLOB_2(A_INFO, loc, glob)
      min(2) = glob(1)
      min(3) = glob(2)
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findintmin2,3*intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findintmin2,3*intsize,1,proclist(1),
     &                   proclist(2),type)
      end if
      glob(1) = min(2)
      glob(2) = min(3)
      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_2_I_M(A, a1, a2, a3, a4, A_INFO, mask, m1, 
     &   m2, m3, m4, MASK_INFO, glob, g1, g2, GLOB_INFO, 
     &   proclist)

C     glob(1), glob(2) = GLOBAL index

      integer a1, a2, a3, a4, m1, m2, m3, m4, g1, g2
      integer A(a1:a2,a3:a4), glob(g1:g2), proclist(*)
      integer A_INFO(8,7), GLOB_INFO(8,7), MASK_INFO(8,7)
      logical mask(m1:m2,m3:m4)
      integer i, j, min(3), loc(2)
      integer status, min_row, max_row, min_col, max_col
      integer intsize, type
      data intsize, type /4, 23/
      integer findintmin2
      external findintmin2

      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)

      min(1) = 2147483647
      do j=min_col, max_col
         do i=min_row, max_row
            if ((A(i,j) .LT. min(1)) .AND. mask(i,j)) then
               min(1) = A(i,j)
               loc(1) = i
               loc(2) = j
            end if
         end do
      end do

      call LOC_TO_GLOB_2(A_INFO, loc, glob)
      min(2) = glob(1)
      min(3) = glob(2)
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findintmin2,3*intsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findintmin2,3*intsize,1,proclist(1),
     &                  proclist(2),type)
      end if

      glob(1) = min(2)
      glob(2) = min(3)

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  

C     FOR REAL


      subroutine MINLOC_1_R(A, a1, a2, A_INFO, glob, g1, g2, 
     &       GLOB_INFO, proclist)

C     glob = GLOBAL index
      
      integer a1, a2, g1, g2, GLOB_INFO(8,7)
      integer A_INFO(8,7), glob(g1:g2), proclist(*)
      real A(a1:a2), min(2)
      integer i, status, min_row, max_row, loc
      integer realsize, type
      data realsize, type /4, 23/
      real findrealmin1
      external findrealmin1

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

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

      min(1) = A(min_row)
      loc = min_row

      do i=min_row+1, max_row
         if (A(i) .LT. min(1)) then
            min(1) = A(i)
            loc = i
         end if
      end do
      
      call LOC_TO_GLOB_1(A_INFO, loc, i)
      min(2) = i
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findrealmin1,2*realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findrealmin1,2*realsize,1,proclist(1),
     &                 proclist(2),type)
      end if         
      glob(1) = min(2)

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_1_R_M(A, a1, a2, A_INFO, mask, m1, m2, 
     &        MASK_INFO, glob, g1, g2, GLOB_INFO, proclist)

C     glob = GLOBAL index

      integer a1, a2, g1, g2, m1, m2, GLOB_INFO(8,7), MASK_INFO(8,7)
      integer A_INFO(8,7), glob(g1:g2), proclist(*)
      real A(a1:a2), min(2)
      logical mask(m1:m2)
      integer i, status, min_row, max_row, loc
      integer realsize, type
      data realsize, type /4, 23/
      real findrealmin1
      external findrealmin1

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

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

      min(1) = 2147483647.0

      do i=min_row, max_row
         if ((A(i) .LT. min(1)) .AND. mask(i)) then
            min(1) = A(i)
            loc = i
         end if
      end do
      
      call LOC_TO_GLOB_1(A_INFO, loc, i)
      min(2) = i
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findrealmin1,2*realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findrealmin1,2*realsize,1,proclist(1),
     &                   proclist(2),type)
      end if
      glob(1) = min(2)

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_2_R(A, a1, a2, a3, a4, A_INFO, glob, g1, g2, 
     &   GLOB_INFO, proclist)

C     glob(1), glob(2) = GLOBAL index

      integer a1, a2, a3, a4, g1, g2
      integer glob(g1:g2), A_INFO(8,7), proclist(*), GLOB_INFO(8,7)
      real A(a1:a2,a3:a4), min(3)
      integer i, j, loc(2)
      integer status, min_row, max_row, min_col, max_col
      integer realsize, type
      data realsize, type /4, 23/
      real findrealmin2
      external findrealmin2

      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)

      min(1) = A(min_row,min_col)
      loc(1) = min_row
      loc(2) = min_col
      do j=min_col, max_col
         do i=min_row, max_row
            if (A(i,j) .LT. min(1)) then
               min(1) = A(i,j)
               loc(1) = i
               loc(2) = j
            end if
         end do
      end do

      call LOC_TO_GLOB_2(A_INFO, loc, glob)
      min(2) = glob(1)
      min(3) = glob(2)
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findrealmin2,3*realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findrealmin2,3*realsize,1,proclist(1),
     &                   proclist(2),type)
      end if

      glob(1) = min(2)
      glob(2) = min(3)

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_2_R_M(A, a1, a2, a3, a4, A_INFO, mask, m1, 
     &   m2, m3, m4, MASK_INFO, glob, g1, g2, GLOB_INFO, 
     &   proclist)

C     glob(1), glob(2) = GLOBAL index

      integer a1, a2, a3, a4, m1, m2, m3, m4, g1, g2
      integer glob(g1:g2), proclist(*)
      real A(a1:a2,a3:a4), min(3)
      integer A_INFO(8,7), GLOB_INFO(8,7), MASK_INFO(8,7)
      logical mask(m1:m2,m3:m4)
      integer i, j, loc(2)
      integer status, min_row, max_row, min_col, max_col
      integer realsize, type
      data realsize, type /4, 23/
      real findrealmin2
      external findrealmin2

      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)

      min(1) = 2147483647.0
      do j=min_col, max_col
         do i=min_row, max_row
            if ((A(i,j) .LT. min(1)) .AND. mask(i,j)) then
               min(1) = A(i,j)
               loc(1) = i
               loc(2) = j
            end if
         end do
      end do

      call LOC_TO_GLOB_2(A_INFO, loc, glob)
      min(2) = glob(1)
      min(3) = glob(2)
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,findrealmin2,3*realsize,1,IALNOD,0,type)
      else
         status = KXCOMB(min,findrealmin2,3*realsize,1,proclist(1),
     &                  proclist(2),type)
      end if

      glob(1) = min(2)
      glob(2) = min(3)

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  


C     FOR DOUBLE


      subroutine MINLOC_1_D(A, a1, a2, A_INFO, glob, g1, g2, 
     &       GLOB_INFO, proclist)

C     glob = GLOBAL index
      
      integer a1, a2, g1, g2, GLOB_INFO(8,7)
      integer A_INFO(8,7), glob(g1:g2), proclist(*)
      double precision A(a1:a2), min(2)
      integer i, status, min_row, max_row, loc
      integer doublesize, type
      data doublesize, type /8, 23/
      double precision finddoublemin1
      external finddoublemin1

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

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

      min(1) = A(min_row)
      loc = min_row

      do i=min_row+1, max_row
         if (A(i) .LT. min(1)) then
            min(1) = A(i)
            loc = i
         end if
      end do
      
      call LOC_TO_GLOB_1(A_INFO, loc, i)
      min(2) = i
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,finddoublemin1,2*doublesize,1,IALNOD,0,
     &     type)
      else
         status = KXCOMB(min,finddoublemin1,2*doublesize,1,proclist(1),
     &                 proclist(2),type)
      end if         
      glob(1) = min(2)

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_1_D_M(A, a1, a2, A_INFO, mask, m1, m2, 
     &        MASK_INFO, glob, g1, g2, GLOB_INFO, proclist)

C     glob = GLOBAL index

      integer a1, a2, g1, g2, m1, m2, GLOB_INFO(8,7), MASK_INFO(8,7)
      integer A_INFO(8,7), glob(g1:g2), proclist(*)
      double precision A(a1:a2), min(2)
      logical mask(m1:m2)
      integer i, status, min_row, max_row, loc
      integer doublesize, type
      data doublesize, type /8, 23/
      double precision finddoublemin1
      external finddoublemin1

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

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

      min(1) = 2147483647.0

      do i=min_row, max_row
         if ((A(i) .LT. min(1)) .AND. mask(i)) then
            min(1) = A(i)
            loc = i
         end if
      end do
      
      call LOC_TO_GLOB_1(A_INFO, loc, i)
      min(2) = i
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,finddoublemin1,2*doublesize,1,IALNOD,0,
     &          type)
      else
         status = KXCOMB(min,finddoublemin1,2*doublesize,1,proclist(1),
     &                   proclist(2),type)
      end if
      glob(1) = min(2)

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_2_D(A, a1, a2, a3, a4, A_INFO, glob, g1, g2, 
     &   GLOB_INFO, proclist)

C     glob(1), glob(2) = GLOBAL index

      integer a1, a2, a3, a4, g1, g2
      integer glob(g1:g2), A_INFO(8,7), proclist(*), GLOB_INFO(8,7)
      double precision A(a1:a2,a3:a4), min(3)
      integer i, j, loc(2)
      integer status, min_row, max_row, min_col, max_col
      integer doublesize, type
      data doublesize, type /8, 23/
      double precision finddoublemin2
      external finddoublemin2

      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)

      min(1) = A(min_row,min_col)
      loc(1) = min_row
      loc(2) = min_col
      do j=min_col, max_col
         do i=min_row, max_row
            if (A(i,j) .LT. min(1)) then
               min(1) = A(i,j)
               loc(1) = i
               loc(2) = j
            end if
         end do
      end do

      call LOC_TO_GLOB_2(A_INFO, loc, glob)
      min(2) = glob(1)
      min(3) = glob(2)
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,finddoublemin2,3*doublesize,1,IALNOD,0,
     &         type)
      else
         status = KXCOMB(min,finddoublemin2,3*doublesize,1,proclist(1),
     &                   proclist(2),type)
      end if

      glob(1) = min(2)
      glob(2) = min(3)

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine MINLOC_2_D_M(A, a1, a2, a3, a4, A_INFO, mask, m1, 
     &   m2, m3, m4, MASK_INFO, glob, g1, g2, GLOB_INFO, 
     &   proclist)

C     glob(1), glob(2) = GLOBAL index

      integer a1, a2, a3, a4, m1, m2, m3, m4, g1, g2
      integer glob(g1:g2), proclist(*)
      double precision A(a1:a2,a3:a4), min(3)
      integer A_INFO(8,7), GLOB_INFO(8,7), MASK_INFO(8,7)
      logical mask(m1:m2,m3:m4)
      integer i, j, loc(2)
      integer status, min_row, max_row, min_col, max_col
      integer doublesize, type
      data doublesize, type /8, 23/
      double precision finddoublemin2
      external finddoublemin2

      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)

      min(1) = 2147483647.0
      do j=min_col, max_col
         do i=min_row, max_row
            if ((A(i,j) .LT. min(1)) .AND. mask(i,j)) then
               min(1) = A(i,j)
               loc(1) = i
               loc(2) = j
            end if
         end do
      end do

      call LOC_TO_GLOB_2(A_INFO, loc, glob)
      min(2) = glob(1)
      min(3) = glob(2)
      if (proclist(1) .EQ. -1) then
         status = KXCOMB(min,finddoublemin2,3*doublesize,1,IALNOD,0,
     &       type)
      else
         status = KXCOMB(min,finddoublemin2,3*doublesize,1,proclist(1),
     &                  proclist(2),type)
      end if

      glob(1) = min(2)
      glob(2) = min(3)

      return
      end



