      subroutine testclustering
      implicit none
      integer nsamp,ndim,i,ibelong(20),ngroups
      double precision value(20,20),stdvalue(20,20),critdist
      value(1,1)=2.105d0
      value(1,2)=2.301d0
      value(2,1)=1.902d0
      value(2,2)=1.8203d0
      value(3,1)=2.202d0
      value(3,2)=1.9508d0
      value(4,1)=1.861111d0
      value(4,2)=2.05232323d0

      value(5,1)=1.1d0
      value(5,2)=1.3d0
      value(6,1)=0.9d0
      value(6,2)=0.82d0
      value(7,1)=1.2d0
      value(7,2)=0.95d0
      value(8,1)=0.86d0
      value(8,2)=1.05d0

      value(9,1)=10.1d0
      value(9,2)=10.3d0
      value(10,1)=10.9d0
      value(10,2)=0.82d0
      value(11,1)=-11.2d0
      value(11,2)=0.95d0
      value(12,1)=-20.85d0
      value(12,2)=1.05d0
      critdist=0.5d0
      nsamp=12
      ndim=2
      
      call clustering(nsamp,ndim,value(1:nsamp,1:ndim),
     &critdist,ngroups,ibelong)
      call aftercluster(nsamp,ndim,value(1:nsamp,1:ndim),
     &ngroups,ibelong,stdvalue(1:ngroups,1:ndim))
      do i=1,ngroups
        write(*,*)i,value(i,1),value(i,2)
      enddo
      write(*,*)i
      do i=1,ngroups
        write(*,*)i,stdvalue(i,1),stdvalue(i,2)
      enddo

      end

!Cluster points with values differing less than a critical distance value 
      subroutine clustering(nsamp,ndim,value,critdist,ngroups,ibelong)
      implicit none
      integer nsamp,ndim,ibelong(nsamp),ngroups
      double precision value(nsamp,ndim),critdist
!critdist: critical distance. if negative, the criterion is a percentage value
!          from the origin (%)
!outputs:
!ngroups: the number of groups in the input data (value)
!ibelong: which group a point belongs
      integer i,j,k,matrix(nsamp,nsamp),nsum(nsamp)
      double precision dif,radius(nsamp)

      ngroups=nsamp
      if(nsamp.le.1)return

      do i=1,nsamp
        ibelong(i)=-9999
        if(critdist.lt.0.0d0)then
          radius(i)=0.0d0
          do j=1,ndim
            radius(i)=radius(i)+value(i,j)**2
          enddo
          radius(i)=dsqrt(radius(i))*(-critdist*0.01d0)
        else
          radius(i)=critdist
        endif
      enddo
      do i=1,nsamp
        do j=1,nsamp
          matrix(i,j)=0
          if(i.ne.j)then
            dif=0.0d0
            do k=1,ndim
              dif=dif+(value(i,k)-value(j,k))**2
            enddo
            dif=dsqrt(dif)
            if(dif.le.radius(i))matrix(i,j)=1
          endif
        enddo
        nsum(i)=0
        do j=1,nsamp
          nsum(i)=nsum(i)+matrix(i,j)
        enddo
      enddo

      ngroups=0
!finding the point with the most crowded neighbors
50    k=1
      do i=2,nsamp
        if(nsum(i).gt.nsum(k))k=i
      enddo
      if(nsum(k).eq.0)goto 100
      ngroups=ngroups+1
      ibelong(k)=ngroups
      do i=1,nsamp
        if(matrix(k,i).ne.0)then
          ibelong(i)=ngroups
          do j=1,nsamp
            matrix(i,j)=0
          enddo
          matrix(k,i)=0
        endif
      enddo
      do i=1,nsamp
        nsum(i)=0
        do j=1,nsamp
          nsum(i)=nsum(i)+matrix(i,j)
        enddo
      enddo
      goto 50
100   do i=1,nsamp
        if(ibelong(i).lt.0)then
          ngroups=ngroups+1
          ibelong(i)=ngroups
        endif
      enddo
      return
      end

      subroutine aftercluster(nsamp,ndim,value,ngroups,ibelong,stdvalue)
      implicit none
      integer nsamp,ndim,ibelong(nsamp),ngroups
      double precision value(nsamp,ndim),stdvalue(ngroups,ndim)
!ngroups: the number of groups in the input data (value)
!ibelong: which group a point belongs
!replace the first ngroups in value by the group means and store std in stdvalue
      integer i,j,k,n
      double precision fn9999,vector(nsamp),fmean(ngroups,ndim),
     &xmin,xmax
      parameter(fn9999=-9999.0d0)
      do i=1,ngroups
        do j=1,ndim
          n=0
          do k=1,nsamp
            if(ibelong(k).eq.i)then
              n=n+1
              vector(n)=value(k,j)
            endif
          enddo
          call 
     &stdmaxmeanmin(n,vector,stdvalue(i,j),fmean(i,j),xmin,xmax)
        enddo
      enddo
      do i=1,ngroups
        do j=1,ndim
          value(i,j)=fmean(i,j)
        enddo
      enddo
      return
      end
