[R] HCLUST subroutine question -- FORTRAN DO loops
David Emmith
demmith at spadac.com
Thu Mar 9 17:25:29 CET 2006
Shown below is most of the FORTRAN subroutine named HCLUST.
My question concerns the DO loop labeled as '10'. What happened to its
CONTINUE statement? I will assume that after FLAG(I)=.TRUE. is executed that
control returns to DO 10 I=1,N. Am I correct?
Dave
----------------------------
C Initializations
C
DO 10 I=1,N
C We do not initialize MEMBR in order to be able to restart the
C algorithm from a cut.
C MEMBR(I)=1.
10 FLAG(I)=.TRUE.
NCL=N
C
C Carry out an agglomeration - first create list of NNs
C Note NN and DISNN are the nearest neighbour and its distance
C TO THE RIGHT of I.
C
DO 30 I=1,N-1
DMIN=INF
DO 20 J=I+1,N
IND=IOFFST(N,I,J)
IF (DISS(IND).GE.DMIN) GOTO 20
DMIN=DISS(IND)
JM=J
20 CONTINUE
NN(I)=JM
DISNN(I)=DMIN
30 CONTINUE
C
400 CONTINUE
C Next, determine least diss. using list of NNs
DMIN=INF
DO 600 I=1,N-1
IF (.NOT.FLAG(I)) GOTO 600
IF (DISNN(I).GE.DMIN) GOTO 600
DMIN=DISNN(I)
IM=I
JM=NN(I)
600 CONTINUE
NCL=NCL-1
C
C This allows an agglomeration to be carried out.
C
I2=MIN0(IM,JM)
J2=MAX0(IM,JM)
IA(N-NCL)=I2
IB(N-NCL)=J2
CRIT(N-NCL)=DMIN
FLAG(J2)=.FALSE.
C
C Update dissimilarities from new cluster.
C
DMIN=INF
DO 50 K=1,N
IF (.NOT.FLAG(K)) GOTO 50
IF (K.EQ.I2) GOTO 50
IF (I2.LT.K) THEN
IND1=IOFFST(N,I2,K)
ELSE
IND1=IOFFST(N,K,I2)
ENDIF
IF (J2.LT.K) THEN
IND2=IOFFST(N,J2,K)
ELSE
IND2=IOFFST(N,K,J2)
ENDIF
IND3=IOFFST(N,I2,J2)
D12=DISS(IND3)
C
C WARD'S MINIMUM VARIANCE METHOD - IOPT=1.
C
IF (IOPT.EQ.1) THEN
DISS(IND1)=(MEMBR(I2)+MEMBR(K))*DISS(IND1)+
X (MEMBR(J2)+MEMBR(K))*DISS(IND2) - MEMBR(K)*D12
DISS(IND1)=DISS(IND1) / (MEMBR(I2)+MEMBR(J2)+MEMBR(K))
ENDIF
C
C SINGLE LINK METHOD - IOPT=2.
C
IF (IOPT.EQ.2) THEN
DISS(IND1)=MIN(DISS(IND1),DISS(IND2))
ENDIF
C
C COMPLETE LINK METHOD - IOPT=3.
C
IF (IOPT.EQ.3) THEN
DISS(IND1)=MAX(DISS(IND1),DISS(IND2))
ENDIF
C
C AVERAGE LINK (OR GROUP AVERAGE) METHOD - IOPT=4.
C
IF (IOPT.EQ.4) THEN
DISS(IND1)=(MEMBR(I2)*DISS(IND1)+MEMBR(J2)*DISS(IND2))/
X (MEMBR(I2)+MEMBR(J2))
ENDIF
C
C MCQUITTY'S METHOD - IOPT=5.
C
IF (IOPT.EQ.5) THEN
DISS(IND1)=0.5*DISS(IND1)+0.5*DISS(IND2)
ENDIF
C
C MEDIAN (GOWER'S) METHOD - IOPT=6.
C
IF (IOPT.EQ.6) THEN
DISS(IND1)=0.5*DISS(IND1)+0.5*DISS(IND2)-0.25*D12
ENDIF
C
C CENTROID METHOD - IOPT=7.
C
IF (IOPT.EQ.7) THEN
DISS(IND1)=(MEMBR(I2)*DISS(IND1)+MEMBR(J2)*DISS(IND2)-
X MEMBR(I2)*MEMBR(J2)*D12/(MEMBR(I2)+MEMBR(J2)))/
X (MEMBR(I2)+MEMBR(J2))
ENDIF
C
50 CONTINUE
MEMBR(I2)=MEMBR(I2)+MEMBR(J2)
C
C Update list of NNs
C
DO 900 I=1,N-1
IF (.NOT.FLAG(I)) GOTO 900
C (Redetermine NN of I:)
DMIN=INF
DO 870 J=I+1,N
IF (.NOT.FLAG(J)) GOTO 870
IND=IOFFST(N,I,J)
IF (DISS(IND).GE.DMIN) GOTO 870
DMIN=DISS(IND)
JJ=J
870 CONTINUE
NN(I)=JJ
DISNN(I)=DMIN
900 CONTINUE
C
C Repeat previous steps until N-1 agglomerations carried out.
C
IF (NCL.GT.1) GOTO 400
C
C
RETURN
END
C of HCLUST()
More information about the R-help
mailing list