      PROGRAM DPSERUN
      ALLOCATABLE::Q(:,:),na(:),xi(:),nxi(:),NB(:),C(:),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 number of consistencies MINUS INCONSISTENCIES'
      write(*,*) '      WITHIN ROWS left and right of main diagonal'
      WRITE(*,*) '    3 DEFAYS CRITERION '
      WRITE(*,*) '      SUM OF SQUARES OF PROXIMITY SUMS TO MAIN '
      WRITE(*,*) '      DIAGONAL MINUS FROM MAIN DIAGONAL WITHIN ROWS'
      WRITE(*,*) '    4 PROXIMITY SUM '
      write(*,*) '      above main diagonal'
      WRITE(*,*) '    5 WEIGHTED GRADIENT WITHIN ROWS AND COLUMNS '
      write(*,*) '      weighted by positive or negative differences'
      write(*,*) '    6 greenberg pattern'
      write(*,*) '      same as 1 but reversed within the column'
      write(*,*) '      comparisons'
      write(*,*) '    7 EQUALLY SPACED COORDINATES-- PROXIMITY SUMS'
      WRITE(*,*) '      TO MAIN DIAGONAL MINUS FROM MAIN DIAGONAL '
      WRITE(*,*) '      WITHIN ROWS WEIGHTED BY INTEGER CONSTANTS'
      WRITE(*,*) '    8 GREENBERG PATTERN'
      WRITE(*,*) '      SAME AS 5 BUT REVERSED WITH THE COLUMN'
      WRITE(*,*) '      COMPARISONS'
      WRITE(*,*) ' CHOICE? '
      READ(*,1) NOPT
      WRITE(*,552)
      IF((NOPT.EQ.1).OR.(NOPT.EQ.5)) WRITE(*,*) '1 FOR WITHIN ROW COMPAR
     &ISONS ONLY, 2 FOR WITHIN COLUMN COMPARISONS ONLY,
     &3 FOR BOTH COMPARISONS'
      IF((NOPT.EQ.1).OR.(NOPT.EQ.5)) READ(*,*) NCOMP
1     FORMAT(BN,I6)
      GO TO (5000,5000,5000,5000,5000,5000,5000,5000) NOPT
      GO TO 5010
5000  WRITE(*,*) ' NUMBER OF ROWS/COLUMNS IN THE INPUT MATRIX '
      READ(*,1) N
      WRITE(*,552)
      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
503   ALLOCATE (Q(N,N),NA(N),NB(N),XI(2**N),NXI(2**N),C(N),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 ')
505   WRITE(*,*) ' IS THE INPUT MATRIX SYMMETRIC AND READ AS A LOWER'
      WRITE(*,*) ' TRIANGULAR MATRIX WITHOUT DIAGONAL ENTRIES OR AS'
      WRITE(*,*) ' A COMPLETE SQUARE MATRIX '
      WRITE(*,*) '    1 LOWER TRIANGULAR '
      WRITE(*,*) '    2 COMPLETE SQUARE '
      WRITE(*,*) '    3 COMPLETE SQUARE AND SKEW-SYMMETRIC'
      WRITE(*,*) '    4 COMPLETE SQUARE AND SKEW-SYMMETRIC'
      WRITE(*,*) '      BUT USE SIGN INFORMATION ONLY'
      WRITE(*,*) ' CHOICE? '
      READ(*,1) NSYM
      WRITE(*,552)
      GO TO (504,504,504,504) NSYM
      GO TO 505
504   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(((NOPT.EQ.1).OR.(NOPT.EQ.5)).AND.(NCOMP.EQ.1)) WRITE(2,*)
     &'WITHIN ROW COMPARISONS ONLY'
      IF(((NOPT.EQ.1).OR.(NOPT.EQ.5)).AND.(NCOMP.EQ.2)) WRITE(2,*)
     &'WITHIN COLUMN COMPARISONS ONLY'
      IF(((NOPT.EQ.1).OR.(NOPT.EQ.5)).AND.(NCOMP.EQ.3)) WRITE(2,*)
     &'BOTH WITHIN ROW AND COLUMN COMPARISONS USED'
      WRITE(2,552)
      WRITE(2,*) 'INPUT MATRIX '
      IF(NSYM.GE.2) GO TO 1001
      DO 1002 I=2,N
      ISTOP=I-1
      READ(1,INFORM) (Q(I,J),J=1,ISTOP)
      WRITE(2,552)
      WRITE(2,6000) (Q(I,J),J=1,ISTOP)
1002  CONTINUE
      DO 1004 I=1,N
      Q(I,I)=0.0
      DO 1004 J=I+1,N
      Q(I,J)=Q(J,I)
1004  CONTINUE
      WRITE(2,552)
      GO TO 7779
1001  DO 1006 I=1,N
      READ(1,INFORM) (Q(I,J),J=1,N)
      WRITE(2,552)
      WRITE(2,6000) (Q(I,J),J=1,N)
      Q(I,I)=0.0
1006  CONTINUE
6000  FORMAT(2X,6F13.3)
      IF(NSYM.NE.4) GO TO 7779
      DO 9020 I=1,N
      DO 9020 J=1,N
      IF(Q(I,J).GT.0.0) Q(I,J)=1.0
      IF(Q(I,J).LT.0.0) Q(I,J)=-1.0
9020  CONTINUE
7779  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
      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
      IF((NOPT.EQ.3).OR.(NOPT.EQ.7)) GO TO 561
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,19,500,1000,5005,9000,500,9000) NOPT
1000  DO 11 I=1,K
11    SUM=SUM+Q(NA(I),J1)
      GO TO 14
9000  DO 1500 I=1,K
      I1=NA(I)
      DO 1600 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 1600
      IF((NOPT.EQ.6).AND.(Q(I1,J1).LT.Q(I1,J2))) SUM=SUM+1.0
      if((NOPT.EQ.6).AND.(q(i1,j1).gt.q(i1,j2))) sum=sum-1.0
      IF(NOPT.EQ.8) SUM=SUM+Q(I1,J2)-Q(I1,J1)
1600  CONTINUE
1500  CONTINUE
      DO 1700 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 1700
      DO 1800 I=1,K
      I1=NA(I)
      IF((NOPT.EQ.6).AND.(Q(J1,J2).gT.Q(I1,J2))) SUM=SUM+1.0
      if((NOPT.EQ.6).AND.(q(j1,j2).lt.q(i1,j2))) sum=sum-1.0
      IF(NOPT.EQ.8) SUM=SUM+Q(J1,J2)-Q(I1,J2)
1800    CONTINUE
1700    CONTINUE
      GO TO 14
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(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(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
      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)
      SUM=SUM+Q(I1,J2)-Q(J1,J2)
718    CONTINUE
717    CONTINUE
      GO TO 14
19    DO 21 J=1,NK
      J2=NB(J)
      IF(J2.EQ.J1) GO TO 21
      DO 22 I=1,K
      I1=NA(I)
      IF(Q(J1,I1).LT.Q(J1,J2)) SUM=SUM+1.0
      IF(Q(J1,I1).GT.Q(J1,J2)) SUM=SUM-1.0
22    CONTINUE
21    CONTINUE
      GO TO 14
500   DO 501 I=1,K
      I1=NA(I)
501   SUM=SUM+Q(J1,I1)
      DO 502 I=1,NK
      I1=NB(I)
      IF(I1.EQ.J1) GO TO 502
      SUM=SUM-Q(J1,I1)
502   CONTINUE
      IF(NOPT.EQ.3) SUM=SUM*SUM
      IF(NOPT.EQ.7) SUM=SUM*(K+1)
      GO TO 14
14    s=xi(index)
      TEMP=S+SUM
      INDEXT=INDEX+2**(J1-1)
      cp=xi(indext)
      IF(TEMP.LT.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,8005,2002,2003,5006,8004,2002,8004) NOPT
561   DO 562 I=1,N
      RSUM=0.0
      DO 563 J=1,N
563   RSUM=RSUM+Q(I,J)
      IF(NOPT.EQ.3) RSUM=RSUM*RSUM
      IF(NOPT.EQ.7) RSUM=-RSUM
3011  INDEX=2**(I-1)
      xi(index)=rsum
562   CONTINUE
      GO TO 564
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((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))
      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,2004) 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((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
      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
8004  WRITE(2,552)
      WRITE(2,5007) SMAX
      XNCON=0.0
      XNDIF=0.0
      DO 8012 K=1,N
      DO 8012 J=1,K-1
      DO 8012 I=1,J-1
      IF(((K.EQ.J).OR.(K.EQ.I)).OR.(J.EQ.I)) GO TO 8012
      IF((NOPT.EQ.6).AND.(Q(NA(I),NA(J)).LT.Q(NA(I),NA(K))))
     &XNCON=XNCON+1.0
      IF((NOPT.EQ.6).AND.(Q(NA(I),NA(J)).GT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+1.0
      IF((NOPT.EQ.6).AND.(Q(NA(J),NA(K)).GT.Q(NA(I),NA(K))))
     &XNCON=XNCON+1.0
      IF((NOPT.EQ.6).AND.(Q(NA(J),NA(K)).LT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+1.0
      IF((NOPT.EQ.8).AND.(Q(NA(I),NA(J)).LT.Q(NA(I),NA(K))))
     &XNCON=XNCON+ABS(Q(NA(I),NA(J))-Q(NA(I),NA(K)))
      IF((NOPT.EQ.8).AND.(Q(NA(I),NA(J)).GT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+ABS(Q(NA(I),NA(J))-Q(NA(I),NA(K)))
      IF((NOPT.EQ.8).AND.(Q(NA(J),NA(K)).GT.Q(NA(I),NA(K))))
     &XNCON=XNCON+ABS(Q(NA(J),NA(K))-Q(NA(I),NA(K)))
      IF((NOPT.EQ.8).AND.(Q(NA(J),NA(K)).LT.Q(NA(I),NA(K))))
     &XNDIF=XNDIF+ABS(Q(NA(J),NA(K))-Q(NA(I),NA(K)))
8012  CONTINUE
      WRITE(2,552)
      SUM=XNCON+XNDIF
      DIF=XNCON-XNDIF
      WRITE(2,8003) XNCON,XNDIF,SUM,DIF,DIF/SUM
      GO TO 7777
8005  WRITE(2,552)
      WRITE(2,5007) SMAX
      XNCON=0.0
      XNDIF=0.0
      DO 8006 I=2,N-1
      DO 8006 J=1,I-1
      DO 8006 K=I+1,N
      IF(Q(NA(I),NA(J)).LT.Q(NA(I),NA(K))) XNCON=XNCON+1.0
      IF(Q(NA(I),NA(J)).GT.Q(NA(I),NA(K))) XNDIF=XNDIF+1.0
8006  CONTINUE
      WRITE(2,552)
      SUM=XNCON+XNDIF
      DIF=XNCON-XNDIF
      WRITE(2,8003) XNCON,XNDIF,SUM,DIF,DIF/SUM
2004  FORMAT(' THE NUMBER OF GRADIENT COMPARISONS SATISFIED MINUS THOSE
     &DISSATISFIED IS',F9.3)
      GO TO 7777
2003  SUM=0.0
      DO 2006 I=1,N
      DO 2006 J=1,N
2006  SUM=SUM+Q(I,J)
      CM=N*(N-1)/2
      TMAX=SUM-SMAX
      SMAX=SMAX/CM
      TMAX=TMAX/CM
      WRITE(2,552)
      WRITE(2,2007) SMAX
      WRITE(2,2050) TMAX
      GO TO 7777
2007  FORMAT(' AVERAGE ABOVE DIAGONAL PROXIMITY IS ',F13.3)
2050  FORMAT(' AVERAGE BELOW DIAGONAL PROXIMITY IS ',F13.3)
2002  DO 2008 I=1,N
      IF(NOPT.EQ.7) C(NA(I))=I
2008  IF(NOPT.EQ.3) C(NA(I))=0.0
      IF(NOPT.EQ.7) GO TO 8010
      DO 2009 I=1,N
      DO 2009 J=1,N
      IF(I.EQ.J) GO TO 2009
      IF(I.GT.J) GO TO 2010
      C(NA(I))=C(NA(I))-Q(NA(I),NA(J))
      GO TO 2009
2010  C(NA(I))=C(NA(I))+Q(NA(I),NA(J))
2009  CONTINUE
      CN=N
      DO 2011 I=1,N
2011  C(NA(I))=C(NA(I))/CN
      WRITE(2,552)
      IF(NOPT.EQ.3) WRITE(2,*) ' COORDINATES BASED ON DEFAYS CRITERION'
8010  IF(NOPT.EQ.7) WRITE(2,*) 'EQUALLY-SPACED COORDINATES'
      WRITE(2,2012) (C(NA(I)),I=1,N)
2012  FORMAT(20F10.3)
      SUMA=0.0
      SUMB=0.0
      DO 8011 I=1,N-1
      DO 8011 J=I+1,N
      SUMA=SUMA+Q(NA(I),NA(J))*ABS(I-J)
      SUMB=SUMB+ABS(I-J)**2
8011  CONTINUE
      ALPHA=SUMA/SUMB
      WRITE(2,552)
      IF(NOPT.EQ.7) WRITE(2,8040) ALPHA
8040  FORMAT('MULTIPLICATIVE CONSTANT ALPHA', F10.3)
      WRITE(2,552)
3003  SUMA=0.0
      SUMB=0.0
      xx=0.0
      SUMAB=0.0
      SUMAA=0.0
      SUMBB=0.0
      DO 2013 I=1,N
      DO 2013 J=1,N
      IF(I.EQ.J) GO TO 2013
      IF(NOPT.EQ.3) T=ABS(C(NA(I))-C(NA(J)))
      IF(NOPT.EQ.7) T=ALPHA*ABS(I-J)
      xx=xx+(q(na(i),na(j))-t)**2
      SUMA=SUMA+Q(I,J)
      SUMB=SUMB+T
      SUMAB=SUMAB+Q(NA(I),NA(J))*T
      SUMAA=SUMAA+Q(I,J)*Q(I,J)
      SUMBB=SUMBB+T*T
2013  CONTINUE
      CM=N*(N-1)
      EXP=(1.0/CM)*SUMA*SUMB
      DEN=SQRT((SUMAA-((1./CM)*SUMA*SUMA))*(SUMBB-((1./CM)*SUMB*SUMB)))
      RR=(SUMAB-EXP)/DEN
      WRITE(2,552)
      WRITE(2,2014) RR
      write(2,8555) xx
8555  format('RESIDUAL SUMS OF SQUARES FOR SQUARE MATRIX',f15.4)
2014  FORMAT(' CORRELATION BETWEEN PROXIMITIES AND RECONSTRUCTED DISTANC
     &ES IS ',F6.3)
7777  WRITE(2,552)
      WRITE(2,*) ' REORDERED MATRIX '
      DO 600 I=1,N
      IP=NA(I)
      WRITE(2,552)
      WRITE(2,6000) (Q(IP,NA(J)),J=1,N)
600   CONTINUE
      IF(((NSYM.EQ.1).OR.(NSYM.EQ.2)).OR.((NOPT.EQ.6).OR.(NOPT.EQ.8)))
     &STOP
      WRITE(2,552)
      WRITE(2,*) 'CLOSED FORM RESULTS FOR SKEW-SYMMETRIC MATRICES'
      WRITE(2,552)
      DO 9012 I=1,N
9012  C(I)=0.0
      DO 9001 I=1,N
      DO 9001 J=1,N
9001  C(J)=C(J)+Q(I,J)
      DO 9002 I=1,N
      NA(I)=I
9002  C(I)=C(I)/FLOAT(N)
9004  KCHAN=0
      DO 9003 I=1,N-1
      IF(C(I).LE.C(I+1)) GO TO 9003
      TEMP=C(I+1)
      C(I+1)=C(I)
      C(I)=TEMP
      NTEMP=NA(I+1)
      NA(I+1) = NA(I)
      NA(I)=NTEMP
      KCHAN=1
9003  CONTINUE
      IF(KCHAN.EQ.1) GO TO 9004
      WRITE(2,*) 'OBJECT REORDERING'
      WRITE(2,9005) (NA(I),I=1,N)
9005  FORMAT(20I4)
      WRITE(2,552)
      WRITE(2,*) 'COORDINATES'
      WRITE(2,9006) (C(I),I=1,N)
9006  FORMAT(10F8.3)
      SUMA=0.0
      SUMB=0.0
      DO 9007 I=1,N-1
      DO 9007 J=I+1,N
      SUMA=SUMA+Q(NA(I),NA(J))*(J-I)
      SUMB=SUMB+(J-I)**2
9007  CONTINUE
      ALPHA=SUMA/SUMB
      WRITE(2,552)
      WRITE(2,8040) ALPHA
      WRITE(2,552)
      SUMA1=0.0
      SUMB1=0.0
      SUMB2=0.0
      SUMAA1=0.0
      SUMBB1=0.0
      SUMBB2=0.0
      SUMAB1=0.0
      SUMAB2=0.0
      XX1=0.0
      XX2=0.0
      DO 9008 I=1,N-1
      DO 9008 J=I+1,N
      T1=C(J)-C(I)
      T2=ALPHA*(J-I)
      XX1=XX1+(Q(NA(I),NA(J))-T1)**2
      XX2=XX2+(Q(NA(I),NA(J))-T2)**2
      SUMA1=SUMA1+Q(NA(I),NA(J))
      SUMB1=SUMB1+T1
      SUMB2=SUMB2+T2
      SUMAB1=SUMAB1+Q(NA(I),NA(J))*T1
      SUMAB2=SUMAB2+Q(NA(I),NA(J))*T2
      SUMAA1=SUMAA1+Q(NA(I),NA(J))**2
      SUMBB1=SUMBB1+T1*T1
      SUMBB2=SUMBB2+T2*T2
9008  CONTINUE
      CM=(N*(N-1))/2
      EXP1=(1.0/CM)*SUMA1*SUMB1
      EXP2=(1.0/CM)*SUMA1*SUMB2
      DEN1=SQRT((SUMAA1-((1./CM)*SUMA1*SUMA1))*(SUMBB1-((1./CM)*
     &SUMB1*SUMB1)))
      DEN2=SQRT((SUMAA1-((1./CM)*SUMA1*SUMA1))*(SUMBB2-((1./CM)*
     &SUMB2*SUMB2)))
      RR1=(SUMAB1-EXP1)/DEN1
      RR2=(SUMAB2-EXP2)/DEN2
      WRITE(2,*) 'EQUALLY SPACED'
      WRITE(2,2014) RR2
      WRITE(2,8555) 2.0*XX2
      WRITE(2,552)
      WRITE(2,*) 'ESTIMATED COORDINATES'
      WRITE(2,2014) RR1
      WRITE(2,8555) 2.0*XX1
      WRITE(2,552)
      WRITE(2,*) 'REORDERED MATRIX'
      DO 9010 I=1,N
      IP=NA(I)
      WRITE(2,552)
      WRITE(2,6000) (Q(IP,NA(J)),J=1,N)
9010  CONTINUE
      STOP
      END
