[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