# [R] HCLUST subroutine question -- FORTRAN DO loops

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()