c   < @(#)   extras.F 4.8 3/28/94 PSS >

      subroutine WHENEQ(n,array,inc,target,index,nval)
      implicit none
      
c#include "zmalloc.F.h"

      integer n
      real    array(n)
      integer inc
      real    target
      integer index(n)
      integer nval
      
      integer ina
      integer i
      
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
      do 99 i=1,n
       if (array(ina).eq.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
  99  continue
      return
      
      entry WHENNE(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
      do 100 i=1,n
       if (array(ina).ne.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
  100 continue
      return
      
      entry WHENFLT(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
      do 101 i=1,n
       if (array(ina).lt.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
  101 continue
      return
      
      entry WHENFLE(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
      do 102 i=1,n
       if (array(ina).le.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
  102 continue
      return
      
      entry WHENFGE(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
      do 103 i=1,n
       if (array(ina).ge.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
  103 continue
      return
      
      entry WHENFGT(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
c      do 104 i=1,n
c  NEW CODE
      do i = 1,n
c  END NEW CODE
       if (array(ina).gt.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
c  104 continue
c  NEW CODE
      enddo
c  END NEW CODE
      return
      end
      
      subroutine WHENIGT(n,array,inc,target,index,nval)
      implicit none
      
      integer n
      integer array(n)
      integer inc
      integer target
      integer index(n)
      integer nval
      
      integer ina
      integer i
      
      
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
c      do 104 i=1,n
c  NEW CODE
      do i = 1,n
c  END NEW CODE
       if (array(ina).gt.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
c  104 continue
c  NEW CODE
      enddo
c  END NEW CODE
      return
  
      entry WHENILT(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
c      do 104 i=1,n
c  NEW CODE
      do i = 1,n
c  END NEW CODE
       if (array(ina).lt.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
c  104 continue
c  NEW CODE
      enddo
c  END NEW CODE
      return

c  NEW ENTRY
      entry WHENIEQ(n,array,inc,target,index,nval)
      ina = 1
      nval = 0
      if (inc.lt.0) ina = (-inc)*(n-1)+1
      do i=1,n
       if (array(ina).eq.target) then
         nval = nval+1
         index(nval)=i
       endif
       ina = ina + inc
      enddo
c  END NEW CODE

      return
      end
      
      subroutine SCATTER(n,a,index,b)
      implicit none
      integer n
      real a(n)
      integer index(n)
      real b(n)
      integer i
      do 100 i=1,n
       a(index(i)) = b(i)
  100 continue
      return
      end
      
      subroutine GATHER(n,a,b,index)
      implicit none
      integer n
      real a(n)
      real b(n)
      integer index(n)
      integer i
      do 100 i=1,n
       a(i) = b(index(i))
  100 continue
      return
      end
      
      real function SSUM(n,sx,incx)
      implicit none
      integer n
      real sx(n)
      integer incx
      integer i
            
      SSUM = 0.
      do i=1,n
       SSUM = SSUM + sx(1+(i-1)*incx)
      enddo
      return
      end
      
c      integer function SECOND()
c      implicit none
c      integer clock
c      external clock		!$PRAGMA C( clock )
c      SECOND = clock()
c      return 
c      end
      
      integer function ISMAX(n,sx,incx)
      implicit none
      integer n
      real sx(n)
      integer incx
      integer i
      integer j
      real    maxv
      ISMAX = 1
c  NEW CODE
      maxv = -1.0E36
c  END NEW CODE
      do 1 i=1,n
       j = 1 + (i-1)*incx
       if (sx(j).gt.maxv) then
        ISMAX = j
        maxv  = sx(j)
       endif
   1  continue
      return
      end
      
      integer function ISMIN(n,sx,incx)
      implicit none
      integer n
      real sx(n)
      integer incx
      integer i
      integer j
      real    minv
      ISMIN = 1
c  NEW CODE
      minv = 1.0E36
c  END NEW CODE
      do 1 i=1,n
       j = 1 + (i-1)*incx
       if (sx(j).lt.minv) then
        ISMIN = j
        minv  = sx(j)
       endif
   1  continue
      return
      end
      
c      integer function MALLOC(lenword)
c      implicit none
c      integer lenword
c      integer iaddr
c      integer errcode
c      external HPALLOC
c
c      call HPALLOC(iaddr,lenword,errcode,1)
c      MALLOC = iaddr
c      
c      return
c      end