      PROGRAM DPSERTU
      ALLOCATABLE::Q(:,:),na(:),xi(:),nxi(:),NB(:),ND(:),P(:,:)
      ALLOCATABLE::NPREC(:,:)
      COMMON/PARAM/NOPT,N,k,mtc
      logical mtc
      CHARACTER*80 FNAME,GNAME,INFORM
      ires=1
5010  WRITE(*,*) ' MAIN MENU '
      WRITE(*,*) '    1 UNWEIGHTED GRADIENT WITHIN ROWS AND COLUMNS '
      write(*,*) '      number of strict consistencies minus '
      write(*,*) '      inconsistencies ABOVE the main diagonal'
      WRITE(*,*) '    2 WEIGHTED GRADIENT WITHIN ROWS AND COLUMNS '
      write(*,*) '      weighted by positive or negative differences'
      WRITE(*,*) '    3 UNWEIGHTED GRADIENT WITHIN ROWS AND COLUMNS'
      WRITE(*,*) '      NUMBER OF INCONSISTENCIES TO BE MINIMIZED'
      WRITE(*,*) '    4 WEIGHTED GRADIENT WITHIN ROWS AND COLUMNS'
      WRITE(*,*) '      WEIGHTED INCONSISTENCIES TO BE MINIMIZED'
      WRITE(*,*) ' CHOICE? '
      READ(*,1) NOPT
      WRITE(*,552)
      WRITE(*,*) '1 FOR WITHIN ROW COMPARISONS ONLY, 2 FOR WITHIN COLUM
     &N COMPARISONS ONLY, 3 FOR BOTH COMPARISONS-- THESE CHOICES ARE
     &FOR THE SQUARE DERIVED MATRIX'
      READ(*,*) NCOMP
1     FORMAT(BN,I6)
      WRITE(*,*) '1 FOR WITHIN ROW COMPARISONS ONLY, 2 FOR WITHIN COLUM
     &N COMPARISONS ONLY, 3 FOR BOTH COMPARISONS-- THESE CHOICES ARE
     &FOR THE ORIGINAL RECTANGULAR MATRIX'
      READ(*,*) MCOMP
      WRITE(*,*) ' NUMBER OF ROWS IN THE INPUT MATRIX '
      READ(*,1) NR
      WRITE(*,552)
      WRITE(*,*) ' NUMBER OF COLUMNS IN THE INPUT MATRIX'
      READ(*,1) NC
      N=NR+NC
      WRITE(*,*) '0 FOR NO PRECEDENT MATRIX TO BE READ IN AFTER THE
     &DATA; 1 IF A SQUARE PRECEDENT MATRIX TO BE USED (20I2 FORMAT; 0/1
     &WHERE A 1 IF THE ROW OBJECT MUST COME AFTER THE COLUMN OBJECT'
      READ(*,*) MPREC
      ALLOCATE (Q(N,N),NA(N),NB(N),XI(2**N),NXI(2**N),ND(N),P(NR,NC),
     &NPREC(N,N),STAT=IERR)
      IF(IERR.NE.0) WRITE(*,*) 'ARRAY ALLOCATION ERROR'
      IF(IERR.NE.0) STOP
      IF(IERR.EQ.0) WRITE(*,*) 'ARRAY ALLOCATION SUCCESSFUL'
      WRITE(*,*) ' FILE NAME FOR THE INPUT MATRIX '
      READ(*,'(A)') FNAME
      WRITE(*,552)
      WRITE(*,*) ' FILE NAME FOR THE OUTPUT '
      READ(*,'(A)') GNAME
      WRITE(*,552)
      WRITE(*,550)
      WRITE(*,*) FNAME
      WRITE(*,*) GNAME
550   FORMAT(' INPUT AND OUTPUT FILES ARE ')
      WRITE(*,*) ' PROVIDE FORMAT FOR THE INPUT MATRIX '
      READ(*,'(A)') INFORM
      WRITE(*,552)
      WRITE(*,551)
      WRITE(*,*) INFORM
551   FORMAT(' INPUT FORMAT IS ')
      OPEN(1,FILE=FNAME)
      OPEN(2,FILE=GNAME,STATUS='NEW')
      WRITE(2,7799) NOPT
7799  FORMAT(' OPTIMIZATION MENU OPTION ',I4)
      WRITE(2,552)
      IF(NCOMP.EQ.1) WRITE(2,*)
     &'WITHIN ROW COMPARISONS ONLY FOR THE DERIVED SQUARE MATRIX'
      IF(NCOMP.EQ.2) WRITE(2,*)
     &'WITHIN COLUMN COMPARISONS ONLY FOR THE DERIVED SQUARE MATRIX'
      IF(NCOMP.EQ.3) WRITE(2,*)
     &'BOTH WITHIN ROW AND COLUMN COMPARISONS USED FOR THE DERIVED
     & SQUARE MATRIX'
      WRITE(2,552)
      IF(MCOMP.EQ.1) WRITE(2,*)
     &'WITHIN ROW COMPARISONS ONLY FOR THE ORIGINAL MATRIX'
      IF(MCOMP.EQ.2) WRITE(2,*)
     &'WITHIN COLUMN COMPARISONS ONLY FOR THE ORIGINAL MATRIX'
      IF(MCOMP.EQ.3) WRITE(2,*)
     &'BOTH WITHIN ROW AND COLUMN COMPARISONS USED FOR THE ORIGINAL
     & MATRIX'
      WRITE(2,552)
      WRITE(2,*) 'INPUT MATRIX '
      DO 1002 I=1,N
      DO 1002 J=1,N
1002  Q(I,J)=0.0
      DO 1006 I=1,NR
      READ(1,INFORM) (Q(I,J+NR),J=1,NC)
      WRITE(2,552)
      WRITE(2,6000) (Q(I,J+NR),J=1,NC)
1006  CONTINUE
6000  FORMAT(2X,6F13.3)
      DO 1004 I=1,N
      DO 1004 J=I+1,N
1004  Q(J,I)=Q(I,J)
      DO 505 I=1,NR
      DO 505 J=1,NC
505   P(I,J)=Q(I,NR+J)
      WRITE(2,552)
      IF(MPREC.EQ.0) GO TO 6500
      WRITE(2,*) 'PRECEDENT MATRIX'
      WRITE(2,552)
      DO 6501 I=1,N
      READ(1,6502) (NPREC(I,J),J=1,N)
      WRITE(2,6502) (NPREC(I,J),J=1,N)
6501  CONTINUE
      WRITE(2,552)
6502  FORMAT(20I2)
6500  WRITE(*,*) ' PROGRAM RUNNING '
      WRITE(*,552)
      Z=-1.0e+20
      IF(NOPT.LE.2) Z=Z
      IF(NOPT.GT.2) Z=-Z
      NZ=0
      NSUM=(2**N)-1
      DO 2 I=1,NSUM
      xi(i)=z
2     nxi(i)=nz
      DO 560 I=1,N
      INDEX=2**(I-1)
      xi(index)=0.0
560   nxi(index)=i
564   K=0
4     K=K+1
      WRITE(*,3012) K
3012  FORMAT(' PROCESSING SUBSETS OF SIZE ',I4)
      IF(K.EQ.N) 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-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.(N-K+1)
      go to 6050
6050  INDEX=0
      DO 10 I=1,K
10    INDEX=INDEX+2**(NA(I)-1)
      JJ=1
      DO 7 I=1,N
      DO 8 J=1,K
      IF(NA(J).EQ.I) GO TO 7
8     CONTINUE
      NB(JJ)=I
      JJ=JJ+1
7     CONTINUE
      NK=N-K
      IF(MPREC.EQ.0) GO TO 20
      IOUT=0
      DO 6506 I=1,K
      DO 6506 J=1,NK
      IF(NPREC(NA(I),NB(J)).EQ.1) IOUT=1
      IF(NPREC(NA(I),NB(J)).EQ.1) EXIT
6506  CONTINUE
      IF(IOUT.EQ.0) GO TO 20
      IF(MTC) GO TO 6
      GO TO 4
20    DO 9 JJ=1,NK
      J1=NB(JJ)
      SUM=0.0
      GO TO (13,5005,13,5005) NOPT
13    IF(NCOMP.EQ.2) GO TO 8000
      DO 15 I=1,K
      I1=NA(I)
      DO 16 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 16
      IF((I1.LE.NR).AND.((J1.LE.NR).OR.(J2.LE.NR))) GO TO 16
      IF((I1.GT.NR).AND.((J1.GT.NR).OR.(J2.GT.NR))) GO TO 16
      IF((MCOMP.EQ.1).AND.(I1.GT.NR)) GO TO 16
      IF((MCOMP.EQ.2).AND.(I1.LE.NR)) GO TO 16
      IF((NOPT.EQ.1).AND.(Q(I1,J1).LT.Q(I1,J2))) SUM=SUM+1.0
      if(q(i1,j1).gt.q(i1,j2)) sum=sum-1.0
16    CONTINUE
15    CONTINUE
8000  IF(NCOMP.EQ.1) GO TO 14
      DO 17 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 17
      DO 18 I=1,K
      I1=NA(I)
      IF((J2.LE.NR).AND.((J1.LE.NR).OR.(I1.LE.NR))) GO TO 18
      IF((J2.GT.NR).AND.((J1.GT.NR).OR.(I1.GT.NR))) GO TO 18
      IF((MCOMP.EQ.1).AND.(J2.GT.NR)) GO TO 18
      IF((MCOMP.EQ.2).AND.(J2.LE.NR)) GO TO 18
      IF((NOPT.EQ.1).AND.(Q(J1,J2).LT.Q(I1,J2))) SUM=SUM+1.0
      if(q(j1,j2).gt.q(i1,j2)) sum=sum-1.0
18    CONTINUE
17    CONTINUE
      GO TO 14
5005  IF(NCOMP.EQ.2) GO TO 8001
      DO 715 I=1,K
      I1=NA(I)
      DO 716 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 716
      IF((I1.LE.NR).AND.((J1.LE.NR).OR.(J2.LE.NR))) GO TO 716
      IF((I1.GT.NR).AND.((J1.GT.NR).OR.(J2.GT.NR))) GO TO 716
      IF((MCOMP.EQ.1).AND.(I1.GT.NR)) GO TO 716
      IF((MCOMP.EQ.2).AND.(I1.LE.NR)) GO TO 716
      IF(NOPT.EQ.2) SUM=SUM+q(i1,j2)-q(i1,j1)
      IF((NOPT.EQ.4).AND.((Q(I1,J2)-Q(I1,J1)).LT.0.0))
     &SUM=SUM+Q(I1,J2)-Q(I1,J1)
716    CONTINUE
715    CONTINUE
8001  IF(NCOMP.EQ.1) GO TO 14
      DO 717 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 717
      DO 718 I=1,K
      I1=NA(I)
      IF((J2.LE.NR).AND.((J1.LE.NR).OR.(I1.LE.NR))) GO TO 718
      IF((J2.GT.NR).AND.((J1.GT.NR).OR.(I1.GT.NR))) GO TO 718
      IF((MCOMP.EQ.1).AND.(J2.GT.NR)) GO TO 718
      IF((MCOMP.EQ.2).AND.(J2.LE.NR)) GO TO 718
      IF(NOPT.EQ.2) SUM=SUM+Q(I1,J2)-Q(J1,J2)
      IF((NOPT.EQ.4).AND.((Q(I1,J2)-Q(J1,J2)).LT.0.0))
     &SUM=SUM+Q(I1,J2)-Q(J1,J2)
718    CONTINUE
717    CONTINUE
      GO TO 14
14    s=xi(index)
      IF(NOPT.GT.2) SUM=ABS(SUM)
      TEMP=S+SUM
      INDEXT=INDEX+2**(J1-1)
      cp=xi(indext)
      IF((NOPT.LE.2).AND.(TEMP.LT.CP)) GO TO 9
      IF((NOPT.GT.2).AND.(TEMP.GT.CP)) GO TO 9
      xi(indext)=temp
      nxi(indext)=j1
9     CONTINUE
      IF(MTC) GO TO 6
      GO TO 4
5     smax=xi(nsum)
      nt=nxi(nsum)
      WRITE(2,552)
      WRITE(2,*) ' CUMULATIVE OBJECTIVE FUNCTION     PERMUTATION IN REVE
     &RSE ORDER '
      WRITE(2,1010) SMAX,NT
      NA(N)=NT
1010  FORMAT(9X,F13.3,13X,I12)
      NN=N-1
      INDEX=NSUM
      DO 12 I=1,NN
      INDEX=INDEX-(2**(NT-1))
      nt=nxi(index)
      s=xi(index)
      NA(N-I)=NT
12    WRITE(2,1010) S,NT
      GO TO (2000,5006,2000,5006) NOPT
5006  WRITE(2,552)
      WRITE(2,5007) SMAX
      XNCON=0.0
      XNDIF=0.0
      DO 8022 K=1,N
      DO 8022 J=1,K-1
      DO 8022 I=1,J-1
      IF(((K.EQ.J).OR.(K.EQ.I)).OR.(J.EQ.I)) GO TO 8022
      IF(((NA(I).LE.NR).AND.((NA(K).LE.NR).OR.(NA(J).LE.NR))).OR.
     &((NA(I).GT.NR).AND.((NA(K).GT.NR).OR.(NA(J).GT.NR)))) GO TO 9051
      IF(((MCOMP.EQ.1).AND.(NA(I).GT.NR)).OR.((MCOMP.EQ.2).AND.  
     &(NA(I).LE.NR))) GO TO 9051
      IF((NCOMP.NE.2).AND.(Q(NA(I),NA(J)).LT.Q(NA(I),NA(K))))
     &XNCON=XNCON+Q(NA(I),NA(K))-Q(NA(I),NA(J))
      IF((NCOMP.NE.2).AND.(Q(NA(I),NA(J)).GT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+Q(NA(I),NA(J))-Q(NA(I),NA(K))
9051  IF(((NA(K).LE.NR).AND.((NA(I).LE.NR).OR.(NA(J).LE.NR))).OR.  
     &((NA(K).GT.NR).AND.((NA(I).GT.NR).OR.(NA(J).GT.NR)))) GO TO 8022
      IF(((MCOMP.EQ.1).AND.(NA(K).GT.NR)).OR.((MCOMP.EQ.2).AND.  
     &(NA(K).LE.NR))) GO TO 8022
      IF((NCOMP.NE.1).AND.(Q(NA(J),NA(K)).LT.Q(NA(I),NA(K))))
     &XNCON=XNCON+Q(NA(I),NA(K))-Q(NA(J),NA(K))
      IF((NCOMP.NE.1).AND.(Q(NA(J),NA(K)).GT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+Q(NA(J),NA(K))-Q(NA(I),NA(K))
8022  CONTINUE
      WRITE(2,552)
      SUM=XNCON+XNDIF
      DIF=XNCON-XNDIF
      WRITE(2,8003) XNCON,XNDIF,DIF,SUM,DIF/SUM
      GO TO 7777
5007  FORMAT(' INDEX OF GRADIENT COMPARISON IS', F9.3)
552   FORMAT(1H )
2000  CM=1.0
2005  SMAX=SMAX/CM
      WRITE(2,552)
      WRITE(2,5007) SMAX
      XNCON=0.0
      XNDIF=0.0
      DO 8002 K=1,N
      DO 8002 J=1,K-1
      DO 8002 I=1,J-1
      IF(((K.EQ.J).OR.(K.EQ.I)).OR.(J.EQ.I)) GO TO 8002
      IF(((NA(I).LE.NR).AND.((NA(K).LE.NR).OR.(NA(J).LE.NR))).OR.  
     &((NA(I).GT.NR).AND.((NA(K).GT.NR).OR.(NA(J).GT.NR)))) GO TO 9050
      IF(((MCOMP.EQ.1).AND.(NA(I).GT.NR)).OR.((MCOMP.EQ.2).AND.  
     &(NA(I).LE.NR))) GO TO 9050
      IF((NCOMP.NE.2).AND.(Q(NA(I),NA(J)).LT.Q(NA(I),NA(K))))
     &XNCON=XNCON+1.0
      IF((NCOMP.NE.2).AND.(Q(NA(I),NA(J)).GT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+1.0
9050  IF(((NA(K).LE.NR).AND.((NA(I).LE.NR).OR.(NA(J).LE.NR))).OR.  
     &((NA(K).GT.NR).AND.((NA(I).GT.NR).OR.(NA(J).GT.NR)))) GO TO 8002
      IF(((MCOMP.EQ.1).AND.(NA(K).GT.NR)).OR.((MCOMP.EQ.2).AND.
     &(NA(K).LE.NR))) GO TO 8002
      IF((NCOMP.NE.1).AND.(Q(NA(J),NA(K)).LT.Q(NA(I),NA(K))))
     &XNCON=XNCON+1.0
      IF((NCOMP.NE.1).AND.(Q(NA(J),NA(K)).GT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+1.0
8002  CONTINUE
      WRITE(2,552)
      SUM=XNCON+XNDIF
      DIF=XNCON-XNDIF
      WRITE(2,8003) XNCON,XNDIF,DIF,SUM,DIF/SUM
8003  FORMAT('CONSISTENCIES ',F10.3,' INCONSISTENCIES ',F10.3,
     &' DIFFERENCE',F10.3,' SUM',F10.3,' RATIO',F10.3)
      GO TO 7777
7777  WRITE(2,552)
      WRITE(2,*) ' REORDERED MATRIX '
      INR=1
      INC=1
      DO 9001 I=1,N
      IF(NA(I).LE.NR) NB(INR)=NA(I)
      IF(NA(I).LE.NR) INR=INR+1
      IF(NA(I).GT.NR) ND(INC)=NA(I)-NR
      IF(NA(I).GT.NR) INC=INC+1
9001  CONTINUE
      WRITE(2,552)
      WRITE(2,*) 'ROW PERMUTATION'
      WRITE(2,9010) (NB(I),I=1,NR)
9010  FORMAT(20I4)
      WRITE(2,552)
      WRITE(2,*) 'COLUMN PERMUTATION'
      WRITE(2,9010) (ND(I),I=1,NC)
      WRITE(2,552)
      DO 600 I=1,NR
      IP=NB(I)
      WRITE(2,552)
      WRITE(2,6000) (P(IP,ND(J)),J=1,NC)
600   CONTINUE
      STOP
      END
