Initial commit
This commit is contained in:
@@ -0,0 +1,159 @@
|
||||
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
|
||||
Reference in New Issue
Block a user