      MODULE ARRAYS
      SAVE
      ALLOCATABLE::Q(:,:),XI(:,:),Y(:),NCMEM(:),NCSIZE(:),MEMBER(:,:)
      ALLOCATABLE::NA(:),NB(:),NU(:),NENDPT(:,:),NXI(:,:),II(:),JJ(:)
      END MODULE ARRAYS
      PROGRAM HPCLUSTU
      USE ARRAYS
      COMMON/PARAM/NOPT,N,MOPT,NSUB,K,NROW,NCOL,NCLAS
      CHARACTER*80 FNAME,GNAME,INFORM
C*****************INPUT SETUP***************
      WRITE(*,*) 'MAIN MENU'
      WRITE(*,*) '1  AVERAGE PROXIMITY WITHIN SUBSET (USING THE'
      WRITE(*,*) '   THE NUMBER OF ROW PLUS COLUMN OBJECTS)'
      WRITE(*,*) '2  AVERAGE PROXIMITY WITHIN SUBSET'
      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(*,*) 'CHOICE'
      READ(*,1) NOPT
      WRITE(*,552)
      WRITE(*,*) 'OPTIMIZATION METHOD'
      WRITE(*,*) ' 1 MINIMUM OF THE SUM'
      WRITE(*,*) ' 2 MINIMUM OF THE MAXIMUM'
      WRITE(*,*) 'CHOICE?'
      READ(*,1) MOPT
      WRITE(*,552)
      WRITE(*,*) 'NUMBER OF ROWS'
      READ(*,*) NROW
      WRITE(*,*) 'NUMBER OF COLUMNS'
      READ(*,*) NCOL
      N = NROW+NCOL
      WRITE(*,*) 'NUMBER OF INITIAL OBJECT CLASSES TO BE PARTITIONED?'
      READ(*,*) NCLAS
      WRITE(*,*) 'MAXIMUM NUMBER OF SUBSETS TO BE USED'
      WRITE(*,*) 'NO LARGER THAN THE MINIMUM OF THE NUMBER OF'
      WRITE(*,*) 'ROWS AND COLUMNS'
      READ(*,1) NSUB
1     FORMAT(BN,I6)
552   FORMAT(1H )
      IF(MIN(NROW,NCOL).LT.NSUB) WRITE(*,*) 'TOO MANY SUBSETS ASKED'
      IF(MIN(NROW,NCOL).LT.NSUB) STOP
      IF((NCLAS.GE.2).AND.(NCLAS.LE.30)) GO TO 503
      WRITE(*,*) 'PROBLEM SIZE IS OUT OF RANGE'
      STOP
503   CALL CONFIGURE
      WRITE(*,*) 'FILE NAME FOR THE INPUT MATRIX'
      READ(*,'(A)') FNAME
      WRITE(*,552)
      WRITE(*,*) 'FILE NAME FOR THE OUTPUT MATRIX'
      READ(*,'(A)') GNAME
      WRITE(*,552)
      WRITE(*,*) 'PROVIDE FORMAT FOR THE INPUT MATRIX'
      READ(*,'(A)') INFORM
      OPEN(1,FILE=FNAME,STATUS='OLD')
      OPEN(2,FILE=GNAME)
      WRITE(2,101) NOPT
      WRITE(2,552)
101   FORMAT('HETEROGENEITY OPTION',I4)
      IF(MOPT.EQ.1) WRITE(2,*) 'MINIMIZATION OF THE SUM'
      IF(MOPT.EQ.2) WRITE(2,*) 'MINIMIZATION OF THE MAXIMUM'
      WRITE(2,552)
      WRITE(2,*) 'INPUT MATRIX'
      Z=1.0E+20
      DO 6001 I=1,N
      DO 6001 J=1,N
6001  Q(I,J)=Z
      DO 1002 I=1,NROW
      READ(1,INFORM) (Q(I,J+NROW), J=1,NCOL)
      WRITE(2,552)
      WRITE(2,10020) (Q(I,J+NROW), J=1,NCOL)
1002  CONTINUE
10020 FORMAT(10F8.3)
      DO 1004 I=1,N
      Q(I,I)=Z
      DO 1004 J=I+1,N
      Q(J,I)=Q(I,J)
1004  CONTINUE
      WRITE(*,*) 'OBJECT CLASSES TO BE PARTITIONED?'
      WRITE(*,*) '1 THE SAME AS THE NUMBER OF OBJECTS'
      WRITE(*,*) '2 OBJECT CLASS MEMBERSHIP TO BE INPUT'
      READ(*,*) NOBCL
      IF(NOBCL.EQ.2) GO TO 4000
      DO 4001 I=1,N
      NCSIZE(I)=1
4001  MEMBER(I,1)=I
      GO TO 4002
4000  WRITE(*,*) 'INPUT CLASS MEMBERSHIP(SEPARATED BY BLANKS)'
      WRITE(*,*) 'WITH ZEROS INDICATING A DELETED OBJECT'
      WRITE(*,*) 'THE ROW OBJECTS COME FIRST AND THEN THE COLUMN'
      READ(*,*) (NCMEM(I),I=1,N)
4003  FORMAT(40I2)
      DO 4004 I=1,N
4004  NCSIZE(I)=0
      DO 4005 I=1,N
      DO 4006 J=1,N
      IF(NCMEM(I).EQ.J) NCSIZE(J)=NCSIZE(J)+1
      IF(NCMEM(I).EQ.J) MEMBER(J,NCSIZE(J))=I
4006  CONTINUE
4005  CONTINUE
4002  WRITE(2,*) 'CLASS NUMBER / OBJECT MEMBERSHIP IN CLASS'
      DO 4009 I=1,NCLAS
4009  WRITE(2,4008) I,(MEMBER(I,J),J=1,NCSIZE(I))
4008  FORMAT(I3,10X,20I3)
      WRITE(2,552)
      WRITE(*,*) 'PROGRAM RUNNING'
      CALL DYMAIN
      STOP
      END
      SUBROUTINE CONFIGURE
      USE ARRAYS
      COMMON/PARAM/NOPT,N,MOPT,NSUB,K,NROW,NCOL,NCLAS
      ALLOCATE (Q(N,N),XI(NSUB,2**NCLAS),Y(N),NXI(NSUB,2**NCLAS),
     &NCMEM(N),NCSIZE(N),MEMBER(N,N),STAT=IERR)
      IF(IERR.NE.0) WRITE(*,*) 'ARRAY ALLOCATION ERROR'
      IF(IERR.EQ.0) WRITE(*,*) 'ARRAY ALLOCATION SUCCESSFUL'
      IF(IERR.NE.0) STOP
      ALLOCATE (NA(N),NB(N),NU(N),NENDPT(2,N),II(N),JJ(N),STAT=IERR)
      IF(IERR.NE.0) WRITE(*,*) 'ARRAY ALLOCATION ERROR'
      IF(IERR.EQ.0) WRITE(*,*) 'ARRAY ALLOCATION SUCCESSFUL'
      IF(IERR.NE.0) STOP
      RETURN
      END SUBROUTINE CONFIGURE
      SUBROUTINE DYMAIN
      USE ARRAYS
      COMMON/PARAM/NOPT,N,MOPT,NSUB,K,NROW,NCOL,NCLAS
      LOGICAL MTC
C******************INITIALIZE ARRAYS********
      Z=1.0E+20
      NZ=0
      NSUM=(2**NCLAS)-1
      DO 1000 I=1,NSUB
      DO 1000 J=1,NSUM
      XI(I,J) = Z
      NXI(I,J) = NZ
1000  CONTINUE
C**************INITIAL SINGLE SUBSET PROCESSING**************
      K=0
4     K=K+1
      IF(K.GT.NCLAS) GO TO 5
      WRITE(*,3012) K
3012  FORMAT('STAGE ONE PROCESSING SUBSETS OF SIZE',I4)
      MTC=.FALSE.  
6     GO TO 30
30    IF(MTC) GO TO 40
      M2 = 0
      NH=K
      GO TO 50
40    IF(M2.LT.(NCLAS-NH)) NH=0
      NH=NH+1
      M2=NA(K+1-NH)
50    DO 51 J=1,NH
51    NA(K+J-NH) = M2+J
      MTC=NA(1).NE.(NCLAS-K+1)
      GO TO 6050
6050  INDEX=0
      DO 10 I=1,K
10    INDEX=INDEX+2**(NA(I)-1)
C*************SUBSET HETEROGENEITY CALCULATIONS*************
      NOBJ=0
      MOBJ=0
      DO 7610 I=1,K
7610  NOBJ=NOBJ+NCSIZE(NA(I))
      IF(NOBJ.EQ.1) SUM=Z
      IF(NOBJ.EQ.1) GO TO 755
      NCOUNT1=0
      NCOUNT2=0
      DO 200 I=1,K
      DO 200 I1=1,NCSIZE(NA(I))
      IF(MEMBER(NA(I),I1).LE.NROW) NCOUNT1=NCOUNT1+1
      IF(MEMBER(NA(I),I1).GT.NROW) NCOUNT2=NCOUNT2+1
      IF((NCOUNT1.EQ.NOBJ).OR.(NCOUNT2.EQ.NOBJ)) SUM=Z
      IF((NCOUNT1.EQ.NOBJ).OR.(NCOUNT2.EQ.NOBJ)) GO TO 755
200   CONTINUE
      MSUMA=0
      SUM=0.0
      GO TO (13,13,13,753,900,900,900,900,900,900,600,600) NOPT
13    DO 11 I=1,K
      DO 11 J=1,K
      DO 11 I1=1,NCSIZE(NA(I))
      DO 11 J1=1,NCSIZE(NA(I))
      IF(Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).EQ.Z) GO TO 11
      SUM=SUM+Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1))
      MSUMA=MSUMA+1
11    CONTINUE
      GO TO (751,752,755) NOPT
751   SUM=(0.5/FLOAT(NOBJ))*SUM
      GO TO 755
752   SUM=(1.0/FLOAT(MSUMA))*SUM
755   XI(1,INDEX) = SUM
      NXI(1,INDEX) = INDEX
      IF(MTC) GO TO 6
      GO TO 4
753   DO 756 I=1,K
      DO 756 J=1,K
      DO 756 I1=1,NCSIZE(NA(I))
      DO 756 J1=1,NCSIZE(NA(J))
      IF(Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).EQ.Z) GO TO 756
      IF(SUM.LT.Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1))) SUM =
     &Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1))
756   CONTINUE
      GO TO 755
900   JK=1
      DO 951 I=1,NCLAS
      DO 902 J=1,K
      IF(NA(J).EQ.I) GO TO 951
902   CONTINUE
      NB(JK)=I
      JK=JK+1
951   CONTINUE
      DO 4011 I=1,NCLAS-K
4011  MOBJ=MOBJ+NCSIZE(NB(I))
      GO TO(613,602,602,903,903,613) NOPT-4
613   SUMW=0.0
      SUMB=0.0
      MSUMW=0
      MSUMB=0
      DO 904 I=1,K
      DO 904 J=1,K
      DO 904 I1=1,NCSIZE(NA(I))
      DO 904 J1=1,NCSIZE(NA(J))
      IF(Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).EQ.Z) GO TO 904
      MSUMW=MSUMW+1
      SUMW=SUMW+Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1))
904   CONTINUE
590   IF(K.EQ.NCLAS) GO TO 591
      DO 905 I=1,K
      DO 905 J=1,NCLAS-K
      DO 905 I1=1,NCSIZE(NA(I))
      DO 905 J1=1,NCSIZE(NB(J))
      IF(Q(MEMBER(NA(I),I1),MEMBER(NB(J),J1)).EQ.Z) GO TO 905
      MSUMB=MSUMB+1
      SUMB=SUMB+Q(MEMBER(NA(I),I1),MEMBER(NB(J),J1))
905   CONTINUE
591   IF(K.EQ.NCLAS) SUM=(1.0/FLOAT(MSUMW))*SUMW
      IF(K.EQ.NCLAS) GO TO 755
      SUM=(1.0/FLOAT(MSUMW))*SUMW-(1.0/FLOAT(MSUMB))*SUMB
      IF(NOPT.EQ.10) SUM=-(1.0/FLOAT(MSUMB))*SUMB
      GO TO 755
903   IF(K.EQ.NCLAS) GO TO 755
      DO 907 I=1,K
      DO 907 J=1,K
      DO 907 I1=1,NCSIZE(NA(I))
      DO 907 J1=1,NCSIZE(NA(J))
      IF(MEMBER(NA(I),I1).EQ.MEMBER(NA(J),J1)) GO TO 907
      DO 908 L=1,NCLAS-K
      DO 908 L1= 1,NCSIZE(NB(L))
      IF((Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).EQ.Z).OR.                         
     &(Q(MEMBER(NA(I),I1),MEMBER(NB(L),L1)).EQ.Z)) GO TO 907
      MSUMA=MSUMA+1
908   IF(Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).GT.  
     &Q(MEMBER(NA(I),I1),MEMBER(NB(L),L1))) SUM=SUM+1.0
907   CONTINUE
      IF(NOPT.EQ.9) SUM=(1.0/FLOAT(MSUMA))*SUM
      GO TO 755
602   IF(K.EQ.NCLAS) GO TO 755
      DO 603 I=1,K
      DO 603 J=1,K
      DO 603 I1=1,NCSIZE(NA(I))
      DO 603 J1=1,NCSIZE(NA(J))
      IF(MEMBER(NA(I),I1).EQ.MEMBER(NA(J),J1)) GO TO 603
      DO 612 I2=1,K
      DO 612 J2=1,NCLAS-K
      DO 612 L1=1,NCSIZE(NA(I2))
      DO 612 L2=1,NCSIZE(NB(J2))
      IF((Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).EQ.Z).OR.  
     &(Q(MEMBER(NA(I2),L1),MEMBER(NB(J2),L2)).EQ.Z)) GO TO 612
      MSUMA=MSUMA+1
      IF(Q(MEMBER(NA(I),I1),MEMBER(NA(J),J1)).GT.  
     &Q(MEMBER(NA(I2),L1),MEMBER(NB(J2),L2))) SUM=SUM+1.0
612   CONTINUE
603   CONTINUE
      IF(NOPT.EQ.7) SUM=(1.0/FLOAT(MSUMA))*SUM
      GO TO 755
600   IF(NOBJ.EQ.1) GO TO 755
      IP=0
      DO 7500 I=1,K
      DO 7500 I1=1,NCSIZE(NA(I))
      IP=IP+1
      NB(IP)=MEMBER(NA(I),I1)
7500  CONTINUE
      L=0
      DO 2100 I=2,NOBJ
      NU(I)=1
2100  Y(I)=Q(NB(1),NB(I))
3000  DMIN=1.0E+20
      DO 4100 I=2,NOBJ
      IF(Y(I).EQ.(-Z)) GO TO 4100
      IF(Y(I).GE.DMIN) GO TO 4100
      DMIN=Y(I)
      IMIN=I
4100  CONTINUE
      L=L+1
      NENDPT(1,L)=IMIN
      NENDPT(2,L)=NU(IMIN)
      IF(L.EQ.(NOBJ-1)) GO TO 604
      Y(IMIN)=-Z
      DO 1110 I=2,NOBJ
      IF(Y(I).EQ.(-Z)) GO TO 1110
      D1=Q(NB(I),NB(IMIN))
      IF(Y(I).LE.D1) GO TO 1110
      NU(I)=IMIN
      Y(I)=D1
1110  CONTINUE
      GO TO 3000
604   SUMMAX=0.0
      DO 605 I=1,NOBJ-1
      I1=NENDPT(1,I)
      I2=NENDPT(2,I)
      SUM=SUM+Q(NB(I1),NB(I2))
      IF(Q(NB(I1),NB(I2)).GT.SUMMAX) SUMMAX=Q(NB(I1),NB(I2))
605   CONTINUE
      IF(NOPT.EQ.11) SUM=SUMMAX
      GO TO 755
C*****************PROCESSING THE RECURSION*****************
5     DO 610 K=2,NSUB
      WRITE(*,*) 'PROCESSING A STAGE',K
      DO 60 II1=0,1
      DO 60 JJ1=0,MOD(II1+1,2)
      II(1)=II1
      JJ(1)=JJ1
      DO 61 II2=0,1
      DO 61 JJ2=0,MOD(II2+1,2)
      II(2)=II2
      JJ(2)=JJ2
      DO 62 II3=0,1
      DO 62 JJ3=0,MOD(II3+1,2)
      II(3)=II3
      JJ(3)=JJ3
      IF(NCLAS.EQ.3) CALL EVAL
      IF(NCLAS.EQ.3) GO TO 62
      DO 63 II4=0,1
      DO 63 JJ4=0,MOD(II4+1,2)
      II(4)=II4
      JJ(4)=JJ4
      IF(NCLAS.EQ.4) CALL EVAL
      IF(NCLAS.EQ.4) GO TO 63
      DO 64 II5=0,1
      DO 64 JJ5=0,MOD(II5+1,2)
      II(5)=II5
      JJ(5)=JJ5
      IF(NCLAS.EQ.5) CALL EVAL
      IF(NCLAS.EQ.5) GO TO 64
      DO 65 II6=0,1
      DO 65 JJ6=0,MOD(II6+1,2)
      II(6)=II6
      JJ(6)=JJ6
      IF(NCLAS.EQ.6) CALL EVAL
      IF(NCLAS.EQ.6) GO TO 65
      DO 66 II7=0,1
      DO 66 JJ7=0,MOD(II7+1,2)
      II(7)=II7
      JJ(7)=JJ7
      IF(NCLAS.EQ.7) CALL EVAL
      IF(NCLAS.EQ.7) GO TO 66
      DO 67 II8=0,1
      DO 67 JJ8=0,MOD(II8+1,2)
      II(8)=II8
      JJ(8)=JJ8
      IF(NCLAS.EQ.8) CALL EVAL
      IF(NCLAS.EQ.8) GO TO 67
      DO 68 II9=0,1
      DO 68 JJ9=0,MOD(II9+1,2)
      II(9)=II9
      JJ(9)=JJ9
      IF(NCLAS.EQ.9) CALL EVAL
      IF(NCLAS.EQ.9) GO TO 68
      DO 69 II10=0,1
      DO 69 JJ10=0,MOD(II10+1,2)
      II(10)=II10
      JJ(10)=JJ10
      IF(NCLAS.EQ.10) CALL EVAL
      IF(NCLAS.EQ.10) GO TO 69
      DO 70 II11=0,1
      DO 70 JJ11=0,MOD(II11+1,2)
      II(11)=II11
      JJ(11)=JJ11
      IF(NCLAS.EQ.11) CALL EVAL
      IF(NCLAS.EQ.11) GO TO 70
      DO 71 II12=0,1
      DO 71 JJ12=0,MOD(II12+1,2)
      II(12)=II12
      JJ(12)=JJ12
      IF(NCLAS.EQ.12) CALL EVAL
      IF(NCLAS.EQ.12) GO TO 71
      DO 72 II13=0,1
      DO 72 JJ13=0,MOD(II13+1,2)
      II(13)=II13
      JJ(13)=JJ13
      IF(NCLAS.EQ.13) CALL EVAL
      IF(NCLAS.EQ.13) GO TO 72
      DO 73 II14=0,1
      DO 73 JJ14=0,MOD(II14+1,2)
      II(14)=II14
      JJ(14)=JJ14
      IF(NCLAS.EQ.14) CALL EVAL
      IF(NCLAS.EQ.14) GO TO 73
      DO 74 II15=0,1
      DO 74 JJ15=0,MOD(II15+1,2)
      II(15)=II15
      JJ(15)=JJ15
      IF(NCLAS.EQ.15) CALL EVAL
      IF(NCLAS.EQ.15) GO TO 74
      DO 75 II16=0,1
      DO 75 JJ16=0,MOD(II16+1,2)
      II(16)=II16
      JJ(16)=JJ16
      IF(NCLAS.EQ.16) CALL EVAL
      IF(NCLAS.EQ.16) GO TO 75
      DO 76 II17=0,1
      DO 76 JJ17=0,MOD(II17+1,2)
      II(17)=II17
      JJ(17)=JJ17
      IF(NCLAS.EQ.17) CALL EVAL
      IF(NCLAS.EQ.17) GO TO 76
      DO 77 II18=0,1
      DO 77 JJ18=0,MOD(II18+1,2)
      II(18)=II18
      JJ(18)=JJ18
      IF(NCLAS.EQ.18) CALL EVAL
      IF(NCLAS.EQ.18) GO TO 77
      DO 78 II19=0,1
      DO 78 JJ19=0,MOD(II19+1,2)
      II(19)=II19
      JJ(19)=JJ19
      IF(NCLAS.EQ.19) CALL EVAL
      IF(NCLAS.EQ.19) GO TO 78
      DO 79 II20=0,1
      DO 79 JJ20=0,MOD(II20+1,2)
      II(20)=II20
      JJ(20)=JJ20
      IF(NCLAS.EQ.20) CALL EVAL
      IF(NCLAS.EQ.20) GO TO 79
      DO 80 II21=0,1
      DO 80 JJ21=0,MOD(II21+1,21)
      II(21)=II21
      JJ(21)=JJ21
      IF(NCLAS.EQ.21) CALL EVAL
      IF(NCLAS.EQ.21) GO TO 80
      DO 81 II22=0,1
      DO 81 JJ22=0,MOD(II22+1,2)
      II(22)=II22
      JJ(22)=JJ22
      IF(NCLAS.EQ.22) CALL EVAL
      IF(NCLAS.EQ.22) GO TO 81
      DO 82 II23=0,1
      DO 82 JJ23=0,MOD(II23+1,2)
      II(23)=II23
      JJ(23)=JJ23
      IF(NCLAS.EQ.23) CALL EVAL
      IF(NCLAS.EQ.23) GO TO 82
      DO 83 II24=0,1
      DO 83 JJ24=0,MOD(II24+1,2)
      II(24)=II24
      JJ(24)=JJ24
      IF(NCLAS.EQ.24) CALL EVAL
      IF(NCLAS.EQ.24) GO TO 83
      DO 84 II25=0,1
      DO 84 JJ25=0,MOD(II25+1,2)
      II(25)=II25
      JJ(25)=JJ25
      IF(NCLAS.EQ.25) CALL EVAL
      IF(NCLAS.EQ.25) GO TO 84
      DO 85 II26=0,1
      DO 85 JJ26=0,MOD(II26+1,2)
      II(26)=II26
      JJ(26)=JJ26
      IF(NCLAS.EQ.26) CALL EVAL
      IF(NCLAS.EQ.26) GO TO 85
      DO 86 II27=0,1
      DO 86 JJ27=0,MOD(II27+1,2)
      II(27)=II27
      JJ(27)=JJ27
      IF(NCLAS.EQ.27) CALL EVAL
      IF(NCLAS.EQ.27) GO TO 86
      DO 87 II28=0,1
      DO 87 JJ28=0,MOD(II28+1,2)
      II(28)=II28
      JJ(28)=JJ28
      IF(NCLAS.EQ.28) CALL EVAL
      IF(NCLAS.EQ.28) GO TO 87
      DO 88 II29=0,1
      DO 88 JJ29=0,MOD(II29+1,2)
      II(29)=II29
      JJ(29)=JJ(29)
      IF(NCLAS.EQ.29) CALL EVAL
      IF(NCLAS.EQ.29) GO TO 88
      DO 89 II30=0,1
      DO 89 JJ30=0,MOD(II30+1,2)
      II(30)=II30
      JJ(30)=JJ30
      IF(NCLAS.EQ.30) CALL EVAL
      IF(NCLAS.EQ.30) GO TO 89
      STOP
89    CONTINUE
88    CONTINUE
87    CONTINUE
86    CONTINUE
85    CONTINUE
84    CONTINUE
83    CONTINUE
82    CONTINUE
81    CONTINUE
80    CONTINUE
79    CONTINUE
78    CONTINUE
77    CONTINUE
76    CONTINUE
75    CONTINUE
74    CONTINUE
73    CONTINUE
72    CONTINUE
71    CONTINUE
70    CONTINUE
69    CONTINUE
68    CONTINUE
67    CONTINUE
66    CONTINUE
65    CONTINUE
64    CONTINUE
63    CONTINUE
62    CONTINUE
61    CONTINUE
60    CONTINUE
610   CONTINUE
C*******************PRODUCE OUTPUT*********
100   WRITE(2,152)
      WRITE(2,152)
      WRITE(2,*) 'IN THE OUTPUT BELOW, THE CLASSES ARE LABELED'
      WRITE(2,*) 'IN TERMS OF THE DESIGNATION GIVEN ABOVE'
      DO 150 K=1,NSUB
      WRITE(2,152)
      WRITE(2,152)
      WRITE(2,151) K
151   FORMAT( 'NUMBER OF SUBSETS', I4)
152   FORMAT(1H )
      INDEXA=NSUM
      DO 153 KK=1,K
      NSTAGE=K-KK+1
      INDEXB=NXI(NSTAGE,INDEXA)
      DO 780 I=1,NCLAS
780   NA(I)=0
      NSPOT=1
      DO 154 I=1,NCLAS
      NTEST=2**(NCLAS-I)
      IF(NTEST.GT.INDEXB) GO TO 154
      NPRES=NCLAS-I+1
      NA(NSPOT)=NPRES
      NSPOT=NSPOT+1
155   FORMAT(I4)
      INDEXB=INDEXB-2**(NCLAS-I)
154   CONTINUE
      WRITE(2,152)
      WRITE(2,781) (NA(I),I=1,NSPOT-1)
781   FORMAT('CLASS NUMBERS FOR THE SUBSET ADDED',25I3)
      WRITE(2,782) XI(1,NXI(NSTAGE,INDEXA)),XI(NSTAGE,INDEXA)
782   FORMAT('INDEX FOR SUBSET',F13.4,'   CUMULATIVE INDEX',F13.4)
      INDEXA=INDEXA-NXI(NSTAGE,INDEXA)
153   CONTINUE
150   CONTINUE
      RETURN
      END
      SUBROUTINE EVAL
      USE ARRAYS
      COMMON/PARAM/NOPT,N,MOPT,NSUB,K,NROW,NCOL,NCLAS
      INDEXA=0
      INDEXB=0
      INDEXAB=0
      IA=0
      IB=0
      DO 10401 I=1,NCLAS
      IA=IA+II(I)
      IB=IB+JJ(I)
10401 CONTINUE
      IF((IA.LT.(K-1)).OR.(IB.EQ.0)) RETURN
      DO 10301 I=1,NCLAS
      INDEXA=INDEXA+(2**(I-1))*II(I)
      INDEXB=INDEXB+(2**(I-1))*JJ(I)
10301 CONTINUE
      GO TO (10001,20001) MOPT
10001 INDEXAB=INDEXA+INDEXB
      TEMP=XI(K-1,INDEXA)+XI(1,INDEXB)
      GO TO 30001
20001 INDEXAB=INDEXA+INDEXB
      TEMP=MAX(XI(K-1,INDEXA),XI(1,INDEXB))
30001 IF(XI(K,INDEXAB).LT.TEMP) RETURN
      XI(K,INDEXAB) = TEMP
      NXI(K,INDEXAB) = INDEXB
10002 CONTINUE
      RETURN
      END
