      PROGRAM DPHIRS
      integer*1 nxi,nci
      ALLOCATABLE::Q(:,:),QT(:,:),XI(:),NXI(:,:),LAST(:),NCI(:)
      ALLOCATABLE::NTEMP(:),MSUM(:),SUMX(:),BSET(:,:),NBSET(:,:)
      DIMENSION NSUBSET(30,0:30),NA(30),NB(30),Y(30),NENDPT(2,30)
      DIMENSION NE(30),NU(30)
      COMMON/PARAM/NOPT,N,MOPT,MGREED
      CHARACTER*80 FNAME,GNAME,INFORM
      LOGICAL MTC
C**********************INPUT SETUP***********
      WRITE(*,*) 'MAIN MENU'
      WRITE(*,*) '1  AVERAGE PROXIMITY WITHIN SUBSET (USING TWICE'
      WRITE(*,*) '   THE NUMBER OF OBJECTS)'
      WRITE(*,*) '2  AVERAGE PROXIMITY WITHIN SUBSET (USING THE'
      WRITE(*,*) '   NUMBER OF OBJECT PAIRS)'
      WRITE(*,*) '3  SUM OF PROXIMITIES WITHIN SUBSET'
      WRITE(*,*) '4  MAXIMUM PROXIMITY WITHIN SUBSET'
      WRITE(*,*) '5  AVERAGE WITHIN MINUS AVERAGE BETWEEN'
      WRITE(*,*) '6  NUMBER OF PROXIMITIES WITHIN GREATER THAN BETWEEN'
      WRITE(*,*) '7  NORMALIZED OPTION 6'
      WRITE(*,*) '8  COMMON OBJECT INCONSISTENCIES WITHIN VERSUS'
      WRITE(*,*) '   BETWEEN'
      WRITE(*,*) '9  NORMALIZED OPTION 8'
      WRITE(*,*) '10 NEGATIVE OF THE AVERAGE BETWEEN'
      WRITE(*,*) '11 MINIMUM CONNECTIVITY PROXIMITY'
      WRITE(*,*) '12 SPANNING TREE LENGTH'
      WRITE(*,*) '13 BETWEEN SUM OF SQUARES FROM MEAN WITH ORDER '
      WRITE(*,*) '   CONSTRAINTS PLUS LATER UNION CONSTRAINTS'
      WRITE(*,*) '14 BETWEEN SUM OF SQUARES FROM MEAN WITH ORDER'
      WRITE(*,*) '   CONSTRAINTS ONLY'
      WRITE(*,*) '15 NUMBER OF WEAK NEIGHBOR FAILURES WITHIN SUBSET'
      WRITE(*,*) 'CHOICE'
      READ(*,1) NOPT
      WRITE(*,552)
      MOPT=1
      IF(((((((NOPT.NE.1)).AND.(NOPT.NE.2)).AND.(NOPT.NE.3))
     &.AND.(NOPT.NE.4)).AND.(NOPT.NE.11)).AND.(NOPT.NE.12)) GO TO 444
      WRITE(*,*) 'IMPOSITION OF NEW SUBSET ORDER CONSTRAINTS'
      WRITE(*,*) ' 1 NO'
      WRITE(*,*) ' 2 YES'
      WRITE(*,*) 'CHOICE?'
      READ(*,1) MOPT
      WRITE(*,552)
444   MGREED = 2
      IF((NOPT.EQ.5).OR.(NOPT.EQ.10)) MGREED=3
      IF((NOPT.EQ.13).OR.(NOPT.EQ.14)) MGREED=1
1     FORMAT(BN,I6)
552   FORMAT(1H )
      WRITE(*,*) 'NUMBER OF ROWS/COLUMNS FOR THE LOWER TRIANGULAR'
      WRITE(*,*) 'MATRIX-- NO DIAGONAL'
      READ(*,1) N
      IF((N.GE.3).AND.(N.LE.30)) GO TO 503
      WRITE(*,*) 'MATRIX OUT OF RANGE'
      STOP
503   DO 200 I=1,N
      NSUBSET(I,0)=1
      NSUBSET(I,1)=I
      NSUBSET(I,I)=1
200   CONTINUE
      DO 2011 I=3,N
      DO 2011 J=2,I-1
      NSUBSET(I,J)=NSUBSET(I-1,J-1)+NSUBSET(I-1,J)
2011  CONTINUE
      NA(1)=1
      NSUM=1
      DO 202 I=2,N
      NA(I)=NA(I-1)+NSUBSET(N-1,N-I+1)
      NSUM=NSUM+NSUBSET(N-1,N-I+1)
202   CONTINUE
      DO 203 I=1,N
203   NB(I)=NA(I)
      NN=NSUM
      ALLOCATE(Q(N,N),QT(N,N),XI(NN),NXI(NN,N),STAT=IERR)
      IF(IERR.NE.0) WRITE(*,*) 'ARRAY ALLOCATION ERROR'
      IF(IERR.NE.0) STOP
      IF(IERR.EQ.0) WRITE(*,*) 'ARRAYS SUCCESSFULLY ALLOCATED'
      ALLOCATE(LAST(NN),NCI(NN),NTEMP(N),STAT=IERR)
      IF(IERR.NE.0) WRITE(*,*) 'ARRAY ALLOCATION ERROR'
      IF(IERR.NE.0) STOP
      IF(IERR.EQ.0) WRITE(*,*) 'ARRAYS SUCCESSFULLY ALLOCATED'
      ALLOCATE(MSUM(N),SUMX(N),BSET(N,N),NBSET(N,N),STAT=IERR)
      IF(IERR.NE.0) WRITE(*,*) 'ARRAY ALLOCATION ERROR'
      IF(IERR.NE.0) STOP
      IF(IERR.EQ.0) WRITE(*,*) 'ARRAYS SUCCESSFULLY ALLOCATED'
      WRITE(*,*) 'FILE NAME FOR THE INPUT MATRIX'
      READ(*,'(A)') FNAME
      WRITE(*,552)
      WRITE(*,*) 'FILE NAME FOR THE OUTPUT MATRIX'
      READ(*,'(A)') GNAME
      WRITE(*,552)
      OPEN(1,FILE=FNAME,STATUS='OLD')
      OPEN(2,FILE=GNAME)
      WRITE(*,*) 'PROVIDE FORMAT FOR THE INPUT MATRIX'
      READ(*,'(A)') INFORM
      WRITE(2,1100) NOPT
1100  FORMAT( 'TRANSITION CRITERION USED', I4)
      WRITE(2,552)
      WRITE(2,*) 'MINIMIZATION OF THE SUM'
      WRITE(2,552)
      WRITE(*,*) '0 IF CONSTRAINED ORDER IS TO BE THE IDENTITY'
      WRITE(*,*) '1 IF IT IS TO BE INPUT'
      READ(*,*) NCON
      DO 6001 I=1,N
      NE(I)=I
6001  CONTINUE
      IF(NCON.EQ.1) WRITE(*,*) 'ENTER ORDER SEPARATED BY BLANKS'
      IF(NCON.EQ.1) READ(*,*) (NE(I),I=1,N)
      WRITE(2,*) 'CONSTRAINT ORDERING'
      WRITE(2,601) (NE(I),I=1,N)
601   FORMAT(20I4)
      WRITE(2,552)
      IF(MOPT.EQ.1) WRITE(2,*)'NO SUBSET ORDER CONSTRAINTS IMPOSED'
      IF(MOPT.EQ.2) WRITE(2,*) 'SUBSET ORDER CONSTRAINTS IMPOSED'
      WRITE(2,552)
      IF(MGREED.EQ.3)
     &WRITE(2,*) 'NO PRELIMINARY GREEDY ALGORITHM USED FOR A BOUND'
      IF(MGREED.EQ.2)
     &WRITE(2,*) 'PRELIMINARY GREEDY ALGORITHM USED FOR A BOUND'
      WRITE(2,552)
      WRITE(2,*) 'INPUT MATRIX'
      DO 1002 I=2,N
      ISTOP=I-1
      READ(1,INFORM) (QT(I,J),J=1,ISTOP)
      WRITE(2,552)
      WRITE(2,1008) (QT(I,J),J=1,ISTOP)
1008  FORMAT(10F8.3)
1002  CONTINUE
      DO 1004 I=1,N
      QT(I,I)=0.0
      DO 1004 J=1,N
      QT(I,J)=QT(J,I)
1004  CONTINUE
      WRITE(2,552)
      DO 900 I=1,N
      DO 900 J=1,N
900   Q(I,J)=QT(NE(I),NE(J))
      WRITE(2,*) 'REORDERED MATRIX TO BE CLUSTERED'
      DO 2001 I=1,N
      WRITE(2,552)
2001  WRITE(2,1008) (Q(I,J),J=1,N)
      WRITE(2,552)
      WRITE(*,*) 'PROGRAM RUNNING'
C*********************INITIALIZING ARRAYS**********
      mtc=(n.eq.n)
      Z=1.0E+20
      NZ=0
      DO 1000 I=1,NSUM
      NCI(I) = NZ
      XI(I)=Z
      LAST(I)=1
      DO 6010 J=1,N
6010  NXI(I,J) = NZ
1000  CONTINUE
      XI(1)=0.0
C*************CONSTRUCTING AND STORING PARTITIONS********
      NN=NSUM
      K=0
4     K=K+1
      WRITE(*,3012) K
3012  FORMAT(' PROCESSSING SUBSETS OF SIZE ', I4)
      IF(K.EQ.(N-1)) GO TO 5
      MTC=.FALSE.
6     GO TO 30
30    IF(MTC) GO TO 40
      M2=0
      NH=K
      GO TO 50
40    IF(M2.LT.(N-1-NH)) NH=0
      NH=NH+1
      M2=NE(K+1-NH)
50    DO 51 J=1,NH
51    NE(K+J-NH)=M2+J
      MTC=NE(1).NE.(N-1-K+1)
      DO 8900 I=1,N
      IF(I.LE.NE(1)) NXI(NB(N-K),I)=1
      IF(I.GT.NE(K)) NXI(NB(N-K),I) = K+1
      IF(K.EQ.1) GO TO 8900
      DO 8901 J=1,K-1
      IF((I.GT.NE(J)).AND.(I.LE.NE(J+1))) NXI(NB(N-K),I)=J+1
8901  CONTINUE
8900  CONTINUE
      NCI(NB(N-K))=K+1
      NB(N-K)=NB(N-K)+1
      IF(MTC) GO TO 6
      GO TO 4
5     NCI(NSUM)=1
      NCI(1)=N
      DO 8922 I=1,N
      NXI(1,I)=I
8922  NXI(NSUM,I)=1
C      do 7750 i=1,nsum
C7750  write(2,7751)(nxi(i,j),j=1,n),nci(i)
C7751  format(20i4)
C*********************PROCESSING THE RECURSION*********
      BOUND=1.0E+19
      NBINDEX=0
      I=1
824   IF((MGREED.EQ.1).AND.(XI(I).GT.(BOUND+.0000001))) GO TO 603
      IF(MGREED.GE.2) BOUND=1.0E+19
C     write(*,*) i
      NC=NCI(I)
      GO TO (800,800,800,951,800,801,801,802,802,800,803,803,800,
     &951,1600) NOPT
800   DO 950 K1=1,NC
      DO 950 K2=1,NC
      BSET(K1,K2)=0.0
950   NBSET(K1,K2)=0
      DO 952 J1=1,N-1
      DO 952 J2=J1+1,N
      BSET(NXI(I,J1),NXI(I,J2))=BSET(NXI(I,J1),NXI(I,J2))+Q(J1,J2)
952   NBSET(NXI(I,J1),NXI(I,J2))=NBSET(NXI(I,J1),NXI(I,J2))+1
      DO 953 K1=1,NC-1
      DO 953 K2=K1+1,NC
      BSET(K1,K2)=BSET(K1,K2)+BSET(K2,K1)+BSET(K1,K1)+BSET(K2,K2)
      NBSET(K1,K2)=NBSET(K1,K2)+NBSET(K2,K1)+NBSET(K1,K1)+NBSET(K2,K2)
      BSET(K2,K1)=BSET(K1,K2)
      NBSET(K2,K1)=NBSET(K1,K2)
953   CONTINUE
      GO TO 951
1600  DO 1604 K1=1,NC
      DO 1604 K2=1,NC
      BSET(K1,K2)=0.0
      NBSET(K1,K2)=0
1604  CONTINUE
      DO 1601 K1=1,NC
      DO 1601 K2=K1,NC
      DO 1602 J1=1,N-1
      DO 1602 J2=J1+1,N
      DO 1603 I1=1,N-1
      DO 1603 I2=I1+1,N
      IF(((((NXI(I,J1).EQ.K1).OR.(NXI(I,J1).EQ.K2)).AND.  
     &((NXI(I,J2).EQ.K1).OR.(NXI(I,J2).EQ.K2))).AND.  
     &(((NXI(I,I1).NE.K1).AND.(NXI(I,I1).NE.K2)).AND.  
     &((NXI(I,I2).NE.K1).AND.(NXI(I,I2).NE.K2)))).AND.  
     &((Q(J1,J2)+Q(I1,I2)).GT.(MIN((Q(J1,I1)+Q(J2,I2)),
     &(Q(J1,I2)+Q(J2,I1)))))) BSET(K1,K2)=BSET(K1,K2)+1.0
1603  CONTINUE
1602  CONTINUE
1601  CONTINUE
      DO 1605 K1=1,NC-1
      DO 1605 K2=K1+1,NC
      BSET(K2,K1)=BSET(K1,K2)
      NBSET(K2,K1)=NBSET(K1,K2)
1605  CONTINUE
      GO TO 951
801   DO 804 K1=1,NC
      DO 804 K2=1,NC
      BSET(K1,K2)=0.0
      NBSET(K1,K2)=0
804   CONTINUE
      DO 1500 K1=1,NC
      DO 1500 K2=K1,NC
      DO 805 J1=1,N-1
      DO 805 J2=J1+1,N
      DO 806 I1=1,N-1
      DO 806 I2=I1+1,N
      IF(((((NXI(I,J1).EQ.K1).OR.(NXI(I,J1).EQ.K2)).AND.
     &((NXI(I,J2).EQ.K1).OR.(NXI(I,J2).EQ.K2))).AND.  
     &((((NXI(I,I1).EQ.K1).OR.(NXI(I,I1).EQ.K2)).AND.  
     &((NXI(I,I2).NE.K1).AND.(NXI(I,I2).NE.K2))).OR.  
     &(((NXI(I,I2).EQ.K1).OR.(NXI(I,I2).EQ.K2)).AND.  
     &((NXI(I,I1).NE.K1).AND.(NXI(I,I1).NE.K2))))).AND.  
     &(Q(J1,J2).GT.Q(I1,I2)))
     &BSET(K1,K2)=BSET(K1,K2)+1.0
      IF((((NXI(I,J1).EQ.K1).OR.(NXI(I,J1).EQ.K2)).AND.
     &((NXI(I,J2).EQ.K1).OR.(NXI(I,J2).EQ.K2))).AND.  
     &((((NXI(I,I1).EQ.K1).OR.(NXI(I,I1).EQ.K2)).AND.  
     &((NXI(I,I2).NE.K1).AND.(NXI(I,I2).NE.K2))).OR.  
     &(((NXI(I,I2).EQ.K1).OR.(NXI(I,I2).EQ.K2)).AND.  
     &((NXI(I,I1).NE.K1).AND.(NXI(I,I1).NE.K2)))))
     &NBSET(K1,K2)=NBSET(K1,K2)+1
806   CONTINUE
805   CONTINUE
1500  CONTINUE
      DO 807 K1=1,NC-1
      DO 807 K2=K1+1,NC
      BSET(K2,K1)=BSET(K1,K2)
      NBSET(K2,K1)=NBSET(K1,K2)
807   CONTINUE
      GO TO 951
802   DO 808 K1=1,NC
      DO 808 K2=1,NC
      BSET(K1,K2) = 0.0
      NBSET(K1,K2) = 0
808   CONTINUE
      DO 1501 K1=1,NC
      DO 1501 K2=K1,NC
      DO 809 J1=1,N
      DO 809 J2=1,N
      IF(J1.EQ.J2) GO TO 809
      DO 810 I1=1,N
      IF((I1.EQ.J1).OR.(I1.EQ.J2)) GO TO 810
      IF(((((NXI(I,J1).EQ.K1).OR.(NXI(I,J1).EQ.K2)).AND.
     &((NXI(I,J2).EQ.K1).OR.(NXI(I,J2).EQ.K2))).AND.  
     &((NXI(I,I1).NE.K1).AND.(NXI(I,I1).NE.K2))).AND.  
     &(Q(J1,J2).GT.Q(J1,I1)))
     &BSET(K1,K2)=BSET(K1,K2)+1.
      IF((((NXI(I,J1).EQ.K1).OR.(NXI(I,J1).EQ.K2)).AND.
     &((NXI(I,J2).EQ.K1).OR.(NXI(I,J2).EQ.K2))).AND.  
     &((NXI(I,I1).NE.K1).AND.(NXI(I,I1).NE.K2)))
     &NBSET(K1,K2)=NBSET(K1,K2)+1.  
810   CONTINUE
809   CONTINUE
1501  CONTINUE
      DO 830 K1=1,NC-1
      DO 830 K2=K1+1,NC
      BSET(K2,K1)=BSET(K1,K2)
      NBSET(K2,K1)=NBSET(K1,K2)
830   CONTINUE
      GO TO 951
803   DO 811 K1=1,NC
      DO 811 K2=1,NC
      BSET(K1,K2)=0.0
811   CONTINUE
      DO 812 K1=1,NC
      DO 812 K2=K1,NC
      NUMBER=0
      DO 813 JJ=1,N
      IF((NXI(I,JJ).EQ.K1).OR.(NXI(I,JJ).EQ.K2)) NB(NUMBER+1)=JJ
      IF((NXI(I,JJ).EQ.K1).OR.(NXI(I,JJ).EQ.K2)) NUMBER=NUMBER+1
813   CONTINUE
      IF(NUMBER.EQ.1) GO TO 812
      L=0
      DO 2100 II=2,NUMBER
      NU(II)=1
2100  Y(II)=Q(NB(1),NB(II))
3000  DMIN=Z
      DO 4100 II=2,NUMBER
      IF(Y(II).EQ.(-Z)) GO TO 4100
      IF(Y(II).GE.DMIN) GO TO 4100
      DMIN=Y(II)
      IMIN=II
4100  CONTINUE
      L=L+1
      NENDPT(1,L)=IMIN
      NENDPT(2,L)=NU(IMIN)
      IF(L.EQ.(NUMBER-1)) GO TO 870
      Y(IMIN)=-Z
      DO 1110 II=2,NUMBER
      IF(Y(II).EQ.(-Z)) GO TO 1110
      D1=Q(NB(II),NB(IMIN))
      IF(Y(II).LE.D1) GO TO 1110
      NU(II)=IMIN
      Y(II)=D1
1110  CONTINUE
      GO TO 3000
870   SUM=0.0
      SUMMAX=0.0
      DO 851 II=1,NUMBER-1
      J1=NENDPT(1,II)
      J2=NENDPT(2,II)
      SUM=SUM+Q(NB(J1),NB(J2))
      IF(Q(NB(J1),NB(J2)).GT.SUMMAX) SUMMAX=Q(NB(J1),NB(J2))
851   CONTINUE
      IF(NOPT.EQ.11) BSET(K1,K2) = SUMMAX
      IF(NOPT.EQ.11) BSET(K2,K1) = SUMMAX
      IF(NOPT.EQ.12) BSET(K1,K2) = SUM
      IF(NOPT.EQ.12) BSET(K2,K1) = SUM
812   CONTINUE
      GO TO 951
951   DO 604 I1=1,NC-1
      I2=I1+1
      SUM=0.0
      GO TO (605,605,605,610,817,605,605,605,605,817,605,605,
     &609,609,605) NOPT
817   BSUM=0.0
      NBSUM=0
      DO 819 JJ=1,NC
      IF((JJ.EQ.I1).OR.(JJ.EQ.I2)) GO TO 819
      BSUM=BSUM+BSET(I1,JJ)+BSET(I2,JJ)-BSET(I1,I1)-2.0*BSET(JJ,JJ)
     &-BSET(I2,I2)
      NBSUM=NBSUM+NBSET(I1,JJ)+NBSET(I2,JJ)-NBSET(I1,I1)-NBSET(I2,I2)
     &-2*NBSET(JJ,JJ)
819   CONTINUE
      IF((NBSUM.EQ.0).AND.(NOPT.EQ.5)) SUM=
     &BSET(I1,I2)/FLOAT(NBSET(I1,I2))
      IF((NBSUM.EQ.0).AND.(NOPT.EQ.5)) GO TO 850
      IF(NOPT.EQ.5) SUM=(BSET(I1,I2)/FLOAT(NBSET(I1,I2)))-
     &(BSUM/FLOAT(NBSUM))
      IF((NOPT.EQ.10).AND.(NBSUM.NE.0)) SUM=-BSUM/FLOAT(NBSUM)
      IF((NOPT.EQ.10).AND.(NBSUM.EQ.0)) SUM=0.0
850   GO TO 607
605   DO 440 JJ=1,NC
      SUMX(JJ)=BSET(JJ,JJ)
440   MSUM(JJ)=NBSET(JJ,JJ)
      IF(NOPT.NE.1) GO TO 860
      DO 814 JJ=1,NC
814   NB(JJ)=0
      DO 815 JJ=1,N
      NB(NXI(I,JJ))=NB(NXI(I,JJ))+1
815   CONTINUE
      DO 816 JJ=1,NC
816   MSUM(JJ)=NB(JJ)
      NBSET(I1,I2)=(NB(I1)+NB(I2))
860   SUM=BSET(I1,I2)
      NSUM=NBSET(I1,I2)
      IF(((((NOPT.EQ.1).OR.(NOPT.EQ.2)).OR.(NOPT.EQ.7)).OR.(NOPT.EQ.9))
     &.AND.(NSUM.NE.0)) SUM = SUM/FLOAT(NSUM)
      IF(MOPT.EQ.1) GO TO 607
      SMAX=0.0
      DO 442 JJ=1,NC
      IF(((((NOPT.EQ.1).OR.(NOPT.EQ.2)).OR.(NOPT.EQ.7)).OR.(NOPT.EQ.9))
     &.AND.(MSUM(JJ).NE.0)) SUMX(JJ)=SUMX(JJ)/FLOAT(MSUM(JJ))
      IF(SUMX(JJ).GT.SMAX) SMAX=SUMX(JJ)
442   CONTINUE
      IF(SUM.LT.SMAX) GO TO 604
      GO TO 607
610   SUM=0.0
      DO 441 JJ=1,NC
441   SUMX(JJ)=0.0
      DO 608 J1=1,N-1
      DO 608 J2=J1+1,N
      IF(((NXI(I,J1).EQ.I1).OR.(NXI(I,J1).EQ.I2)).AND.
     &((NXI(I,J2).EQ.I1).OR.(NXI(I,J2).EQ.I2))) SUM=MAX(SUM,Q(J1,J2))
      IF(NXI(I,J1).EQ.NXI(I,J2)) SUMX(NXI(I,J1))=
     &MAX(SUMX(NXI(I,J1)),Q(J1,J2))
608   CONTINUE
      SUM=MAX(SUM,SUMX(I1),SUMX(I2))
      IF(MOPT.EQ.1) GO TO 607
      SMAX=0.0
      DO 445 JJ=1,NC
      SMAX=MAX(SMAX,SUMX(JJ))
445   CONTINUE
      IF(SUM.LT.SMAX) GO TO 604
      GO TO 607
609   SUM=0.0
      SUMSQ=0.0
      SUMA=0.0
      SUMB=0.0
      NSUMA=0
      NSUMB=0
      NSUM=0
      DO 430 JJ=1,NC
      MSUM(JJ)=0
430   SUMX(JJ)=0.0
      DO 611 J1=1,N-1
      DO 611 J2=J1+1,N
      IF(((NXI(I,J1).EQ.I1).AND.(NXI(I,J2).EQ.I2)).OR.  
     &((NXI(I,J1).EQ.I2).AND.(NXI(I,J2).EQ.I1))) SUM=SUM+Q(J1,J2)
      IF(((NXI(I,J1).EQ.I1).AND.(NXI(I,J2).EQ.I2)).OR.
     &((NXI(I,J1).EQ.I2).AND.(NXI(I,J2).EQ.I1))) NSUM=NSUM+1
      IF(((NXI(I,J1).EQ.I1).AND.(NXI(I,J2).EQ.I2)).OR.
     &((NXI(I,J1).EQ.I2).AND.(NXI(I,J2).EQ.I1)))
     &SUMSQ=SUMSQ+Q(J1,J2)*Q(J1,J2)
      IF(((NXI(I,J1).EQ.I1).AND.(NXI(I,J2).EQ.I2)).OR.  
     &((NXI(I,J1).EQ.I2).AND.(NXI(I,J2).EQ.I1))) GO TO 611
      IF(NXI(I,J1).EQ.NXI(I,J2)) SUMA=SUMA+Q(J1,J2)
      IF(NXI(I,J1).EQ.NXI(I,J2)) NSUMA=NSUMA+1
      IF(NXI(I,J1).NE.NXI(I,J2)) SUMB=SUMB+Q(J1,J2)
      IF(NXI(I,J1).NE.NXI(I,J2)) NSUMB=NSUMB+1
      DO 431 JJ=1,NC
      IF((NXI(I,J1).EQ.NXI(I,J2)).AND.(NXI(I,J1).EQ.JJ))
     &SUMX(JJ)=SUMX(JJ)+Q(J1,J2)
      IF((NXI(I,J1).EQ.NXI(I,J2)).AND.(NXI(I,J1).EQ.JJ))
     &MSUM(JJ)=MSUM(JJ)+1
431   CONTINUE
611   CONTINUE
      DO 432 JJ=1,NC
432   IF(MSUM(JJ).NE.0) SUMX(JJ)=SUMX(JJ)/FLOAT(MSUM(JJ))
      SMAX=0.0
      DO 433 JJ=1,NC
433   IF(SUMX(JJ).GT.SMAX) SMAX=SUMX(JJ)
      IF(NSUMA.NE.0) SUMA=SUMA/FLOAT(NSUMA)
      IF(NSUMB.NE.0) SUMB=SUMB/FLOAT(NSUMB)
      TT=SUM/FLOAT(NSUM)
      IF((NC.GT.2).AND.((SUMA.GT.TT).OR.(SUMB.LT.TT))) GO TO 604
      IF((NC.EQ.2).AND.(SUMA.GT.TT)) GO TO 604
      IF((NC.GE.2).AND.(SMAX.GT.TT)) GO TO 604
      IF(NC.EQ.2) GO TO 956
      IF(NOPT.EQ.14) GO TO 956
      SMIN=1.0E+20
      DO 955 JJ=1,NC
      IF((JJ.EQ.I1).OR.(JJ.EQ.I2)) GO TO 955
      TMIN=BSET(I1,JJ)+BSET(I2,JJ)
     &-BSET(I1,I1)-BSET(I2,I2)-2.0*BSET(JJ,JJ)
      NTMIN=NBSET(I1,JJ)+NBSET(I2,JJ)
     &-NBSET(I1,I1)-NBSET(I2,I2)-2*NBSET(JJ,JJ)
      IF(NTMIN.NE.0) TMIN=TMIN/FLOAT(NTMIN)
      IF(TMIN.LE.SMIN) SMIN=TMIN
955   CONTINUE
      IF(SMIN.LT.TT) GO TO 604
956   SUM=SUMSQ-(((SUM)**2)/FLOAT(NSUM))
      GO TO 607
607   DO 612 JJ=1,N
      NTEMP(JJ)=NXI(I,JJ)
      IF(NXI(I,JJ).EQ.I2) NTEMP(JJ)=I1
612   IF(NXI(I,JJ).GT.I2) NTEMP(JJ)=NTEMP(JJ)-1
      INDEX=NA(N-NC+2)
C     WRITE(2,*) INDEX,(NTEMP(JJ),JJ=1,N)
614   IF(NCI(INDEX).NE.(NC-1)) GO TO 613
      DO 8902 JJ=1,30
      IF((NXI(INDEX,JJ).NE.NTEMP(JJ)).AND.(JJ.LE.N)) EXIT
      IF(JJ.EQ.N) EXIT
8902  CONTINUE
C     WRITE(2,*)INDEX,JJ
      IF((NXI(INDEX,JJ).EQ.NTEMP(JJ)).AND.(JJ.EQ.N)) GO TO 615
613   INDEX=INDEX+1
      GO TO 614
615   TEMP=XI(I)+SUM
      IF(TEMP.LT.XI(INDEX)) GO TO 9011
      GO TO 604
9011  XI(INDEX) = TEMP
      LAST(INDEX)=I
      IF((MGREED.GE.2).AND.(TEMP.LT.BOUND)) NBINDEX=INDEX
      IF((MGREED.GE.2).AND.(TEMP.LT.BOUND)) BOUND=TEMP
604   CONTINUE
      IF(MGREED.GE.2) I=NBINDEX
603   IF(MGREED.EQ.1) I=I+1
      IF(I.LT.NN) GO TO 824
C****************PRODUCE OUTPUT*********
      WRITE(*,*) 'PRODUCING OUTPUT'
      WRITE(2,552)
      WRITE(2,552)
      IF(MGREED.EQ.2) BOUND=XI(LAST(NBINDEX))
      WRITE(*,*) 'SETTING BOUND'
      IF(MGREED.EQ.2) WRITE(2,1077) BOUND
1077  FORMAT( 'BOUND USED',F18.6)
      IF(MGREED.EQ.2)
     &WRITE(2,*) 'GREEDY PARTITION HIERARCHY TO OBTAIN THE BOUND'
      IF(MGREED.EQ.3) WRITE(2,*) 'GREEDY PARTITION HIERARCHY'
      IF(MGREED.EQ.1) WRITE(2,*) 'OPTIMAL PARTITION HIERARCHY'
      IF(MGREED.EQ.1) WRITE(*,*) 'OPTIMAL PARTITION HIERARCHY'
      WRITE(*,620) NCI(NN),XI(NN),(NXI(NN,J),J=1,N)
      WRITE(2,620) NCI(NN),XI(NN),(NXI(NN,J),J=1,N)
620   FORMAT('SUBSETS ',I3, '  INDEX', F14.4, ' MEMBERSHIP ',15I3)
      JJ=NN
      DO 621 I=1,N-1
      JJ=LAST(JJ)
      IF((NOPT.NE.13).AND.(NOPT.NE.14)) GO TO 621
      DO 960 I1=1,NCI(JJ)-1
      DO 960 I2=I1+1,NCI(JJ)
      SUM=0.0
      NSUM=0
      DO 961 J1=1,N-1
      DO 961 J2=J1+1,N
      IF(((NXI(JJ,J1).EQ.I1).AND.(NXI(JJ,J2).EQ.I2)).OR.  
     &((NXI(JJ,J1).EQ.I2).AND.(NXI(JJ,J2).EQ.I1))) SUM=SUM+Q(J1,J2)
      IF(((NXI(JJ,J1).EQ.I1).AND.(NXI(JJ,J2).EQ.I2)).OR.  
     &((NXI(JJ,J1).EQ.I2).AND.(NXI(JJ,J2).EQ.I1))) NSUM=NSUM+1
961   CONTINUE
      SUM=SUM/FLOAT(NSUM)
      WRITE(2,962) I1,I2,SUM
962   FORMAT(2I5,F10.5)
960   CONTINUE
621   WRITE(2,620) NCI(JJ),XI(JJ),(NXI(JJ,J),J=1,N)
      WRITE(2,552)
      IF((NOPT.NE.13).AND.(NOPT.NE.14)) GO TO 825
      WRITE(*,*) 'CALCULATING RSQUARED'
      SUM=0.0
      SUMSQ=0.0
      DO 740 J1=1,N-1
      DO 740 J2=J1+1,N
      SUM=SUM+Q(J1,J2)
      SUMSQ=SUMSQ+Q(J1,J2)*Q(J1,J2)
740   CONTINUE
      RS=1.0-(XI(NN)/(SUMSQ-((SUM*SUM)/FLOAT(N*(N-1)/2))))
      WRITE(2,741) RS
741   FORMAT('RSQUARED', F10.4)
825   IF(MGREED.EQ.1) GO TO 1650
      MGREED=1
      DO 895 I=1,NN
      XI(I)=Z
895   LAST(I)=1
      XI(1)=0.0
      I=1
      IF(((((NOPT.EQ.5)).OR.(NOPT.EQ.10)).OR.(NOPT.EQ.13))
     &.OR.(NOPT.EQ.14)) BOUND = 1.0E+19
      GO TO 824
1650  DO 1651 KK=2,N-1
      BOUND=Z
      NBOUND=1
      NLB=NA(N-KK+1)
      NUB=NA(N-KK+2)-1
      DO 1652 I = NLB,NUB
      IF(XI(I).GE.BOUND) GO TO 1652
      BOUND=XI(I)
      NBOUND=I
1652  CONTINUE
      WRITE(2,552)
      WRITE(2,1653) KK
1653  FORMAT('OPTIMAL PARTITION HIERARCHY STARTING WITH',I3,' SUBSETS')
      JJ=NBOUND
      DO 1654 I=1,N-KK+1
      WRITE(2,620) NCI(JJ),XI(JJ),(NXI(JJ,J),J=1,N)
      JJ=LAST(JJ)
1654  CONTINUE
1651  CONTINUE
      STOP
      END
