c
      subroutine igetclse(mx,lst,a,grpa,indx,diffmin)
      integer a,grpa(mx)
c
      difff = abs(a - grpa(1))
      do i = 1,lst
        difff = abs(a - grpa(i))
        if(difff.le.diffmin.or.i.eq.1) then
          diffmin = difff
          indx = i
        endif
      enddo
c
      return
      end

      subroutine cgetclse(mx,lst,a,grpa,indx,diffmin)
      complex a,grpa(mx)
c
      diff = abs(a - grpa(1))
      do i = 1,lst
        diff = abs(a - grpa(i))
        if(diff.le.diffmin.or.i.eq.1) then
          diffmin = diff
          indx = i
        endif
      enddo
c
      return
      end

      subroutine xyzgetclse(mx,lst,xyz,node,indx,dismin)
      real xyz(3),node(3,mx)
c
      do i = 1,lst
       distance = dist(node(1,i),xyz)
       if( (distance.le.dismin).or.(i.eq.1) ) then
         indx = i
         dismin = distance
       endif 
      enddo
c
      return
      end

c 
       subroutine isort1d(lenary,datain)
       integer datain(lenary)
       num = lenary
c
       i = 1
       inc = 0
       iok = 1
       dowhile(iok.eq.1)
        i = i + inc
        icnt = 0
        do j = 1,num
         if(datain(i).lt.datain(j)) icnt = icnt + 1
        enddo
        ix = num-icnt
        if(i.ne.ix) then
         inc = 0
         iok = 1
         itmp = datain(ix)
         datain(ix) = datain(i)
         datain(i) = itmp
        else
         if(i+1 .le. num) then
          inc = 1
         else
          inc = 0
          iok = 0
         endif
        endif
       enddo
c
       return
       end
c
      subroutine idntmtrx(mx,isize,mtrx)
      real mtrx(mx,mx)
c
      do irow = 1,isize
         do icol = 1,isize
            mtrx(irow,icol) = 0.0
         enddo
         mtrx(irow,irow) = 1.0
      enddo
      return
      end
c
      function epsil(a,b)
c
      epsil = 1e-02
      if(abs(a).ge.epsil .and. abs(b).ge.epsil) then
        rmax = max(abs(a),abs(b))
        epsil = rmax*epsil
      endif
      if(epsil.lt.1e-02) epsil = 1e-02
c
      return
      end
c
       integer function lenint(intval)
       integer intval
c
       indx = 1
       lenint = 0
       do while (lenint .eq. 0)
          testval = 10**indx
          if (intval .lt. testval) lenint = indx
          indx = indx + 1
       enddo
c
c example format statement:  1000  format (a6,a8,i<nlenint>,a14)
c
       return
       end

      real function dist(x,y)
      real x(3),y(3)
c calculate the distance between x and y
      dist = sqrt( (x(1)-y(1))**2 + (x(2)-y(2))**2 
     %               + (x(3)-y(3))**2 )
      return
      end
c
       integer function indxrc(itotcol,irow,icol)
c
       indxrc = (irow-1)*(itotcol)+icol
c
       return
       end
c
       subroutine rcindx(indx,itotcol,irow,icol) 
c
       irow = (indx-1)/(itotcol) + 1
       icol = jmod(indx,itotcol)
       if(icol.eq.0) icol = itotcol
c
       return
       end
c
      subroutine cmp2xyzar(mx,ar1,ar2,len,esf,itf,irev)
      real ar1(mx,3),ar2(mx,3)
c
      itf = 1
      do i = 1,len
       epsilonx = epsil( ar1(i,1),ar2(i,1) )*esf
       epsilony = epsil( ar1(i,2),ar2(i,2) )*esf
       epsilonz = epsil( ar1(i,3),ar2(i,3) )*esf
       diffx = abs( ar1(i,1) - ar2(i,1) )
       diffy = abs( ar1(i,2) - ar2(i,2) )
       diffz = abs( ar1(i,3) - ar2(i,3) )
       if(diffx.gt.epsilonx .or. diffy.gt.epsilony .or.
     &    diffz.gt.epsilonz) itf = 0 
      enddo
c 
c check reverse order
      if(itf.ne.1) then
       itf = 1
       irev = 0
       do i = 1,len
        ii = len - i + 1
        epsilonx = epsil( ar1(i,1),ar2(ii,1) )
        epsilony = epsil( ar1(i,2),ar2(ii,2) )
        epsilonz = epsil( ar1(i,3),ar2(ii,3) )
        diffx = abs( ar1(i,1) - ar2(ii,1) )
        diffy = abs( ar1(i,2) - ar2(ii,2) )
        diffz = abs( ar1(i,3) - ar2(ii,3) )
        if(diffx.gt.epsilonx .or. diffy.gt.epsilony .or.
     &    diffz.gt.epsilonz) itf = 0 
       enddo
       if(itf.eq.1) irev = 1
      endif
c
      return
      end
c
      subroutine wrtprcnt(prcnt,delprcnt,nexprcnt)
      if(prcnt.ge.nexprcnt) then
       write(6,1000) nexprcnt,'% complete'
       nexprcnt = nexprcnt + delprcnt
      endif
1000  format(3x,i3,a10)
      return
      end
c
c 
      integer function ilininterp(a,c,d,e,f)
      integer a,c,d,e,f
c
c this routine performs a linera interpolation to find
c the value between a and c using d, e, f
c
      ilininterp = ( c*(e-d) + a*(f-e) )/( f-d )
c
      return
      end
c 
      real function rlininterp(a,c,d,e,f)
c
c this routine performs a linera interpolation to find
c the value between a and c using d, e, f
c
      rlininterp = ( c*(e-d) + a*(f-e) )/( f-d )
c
      return
      end
c
