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