SUBROUTINE MSTREE(NC,N,LISTJK,DISTJK,IDX,M) ! minimum spanning tree
*     Elements are numbered 1 ... N and result is in array NC(N).
*     Input is LISTJK(2,M) with M pairs of equivalent elements, 
*     and DISTJK(M), the non-negative distances between the elements.
*     IDX(M) is an auxiliary array used for sorting the distances.
*     Result is in array NC(N): NC(I) is the equivalence class number
*     for element I, and all equivalent elements will have the same
*     equivalence class number.
      INTEGER NC(N),IDX(M),LISTJK(2,M) ! pairs of items
      REAL DISTJK(M) ! non-negative distances between pairs
      INTEGER I,J,K,M,N
*     ...
      DO I=1,M
       IDX(I)=I                 ! prepare index vector
      END DO 
      CALL FSORTH(DISTJK,IDX,M) ! real version of heapsort
      DO J=1,N
       NC(J)=J                  ! initialize classes
      END DO
      DO I=1,M      ! loop in order of increasing distance
       J=LISTJK(1,IDX(I))       
 10    IF(NC(J).NE.J) THEN
          J=NC(J)
          GOTO 10
       END IF
       K=LISTJK(2,IDX(I))       
 20    IF(NC(K).NE.K) THEN
          K=NC(K)
          GOTO 20
       END IF
       IF(J.NE.K) THEN
          NC(J)=K               ! J and K now related
       ELSE 
          DISTJK(I)=-DISTJK(I)-1.0  ! flag as removed
       END IF
      END DO
      DO J=1,N                  
 30      IF(NC(J).NE.NC(NC(J))) THEN
          NC(J)=NC(NC(J))
         GOTO 30
       END IF
      END DO
      END