C======================================================================C
C                                                                      C
C     CLASSIFICATION ASCENDANTE HIERARCHIQUE                           C
C     --------------------------------------                           C
C                                                                      C
C     EN ENTREE :                                                      C
C                 N               : DIMENSION DE SNN ET DE Y           C
C                 SNN   ( N , N ) : MATRICE DES SIMILARITES SYMETRIQUE C
C                                   ( MODIFIEE , PUIS RESTAUREE )      C
C                                                                      C
C     EN SORTIE :                                                      C
C                 Y     ( N , N ) : PARTITION DES INDIVIDUS            C
C                 K               : NOMBRE DE CLASSES ( 1 A N )        C
C                 Z               : DEMI-COUT DE LA PARTITION          C
C                 BORNTH          : BORNE SUPERIEURE THEORIQUE DE Z    C
C                                                                      C
C     ATTENTION :                                                      C
C                 LA DIAGONALE DE Y CONTIENDRA LES NUMEROS DES CLASSES C
C                 LA DIAGONALE DE SNN N'INTERVIENT JAMAIS DANS LE COUT C
C                                                                      C
C======================================================================C
C
      SUBROUTINE PNKCAH ( N , SNN , Y , K , Z , BORNTH )
C
      IMPLICIT INTEGER ( A - Z )
C
C     REAL     SNN ( N , N ) , DSUP , DIJ , Z , BORNTH
      REAL     SNN (   *   ) , DSUP , DIJ , Z , BORNTH
C
C     INTEGER  Y   ( N , N )
      INTEGER  Y   (   *   )
C
C
C     INITIALISATION DE LA PARTITION : 1 CLASSE PAR INDIVIDU
C     CHAQUE CLASSE EST NUMEROTEE DE 1 A N SUR LA DIAGONALE .
C     ------------------------------------------------------
C
      DO I = 1 , N
          DO J = 1 , I-1
              Y ( I + (J-1)*N ) = 0
          END DO
          Y ( I + (I-1)*N ) = I
      END DO
C
      K      = N
C
C
C     CLASSIFICATION ASCENDANTE HIERARCHIQUE ( COUT < (N*N*N-N)/6 )
C     REGROUPEMENT DES  2  CLASSES AYANT LA PLUS GRANDE SIMILARITE ;
C     ON S'ARRETE LORSQUE TOUTES LES SIMILARITES SNN(I,J) SONT < 0.
C     --------------------------------------------------------------
C
20    DSUP   = -1.
      I1     =  0
      I2     =  0
C
      DO I = 1 , N
C
C         ON N'EXAMINE QUE LES CLASSES "ACTIVES" : LES AUTRES
C         LIGNES CORRESPONDENT AUX CLASSES DEJA REGROUPEES
C
          IF ( Y(I+(I-1)*N) .GT. 0 ) THEN
C
              DO J = I+1 , N
C
C                 ON N'EXAMINE QUE LES CLASSES "ACTIVES" : LES AUTRES
C                 COLONNES CORRESPONDENT AUX CLASSES DEJA REGROUPEES
C
                  IF ( Y(J+(J-1)*N) .GT. 0 ) THEN
C
                      DIJ    = SNN ( I + (J-1)*N )
C
                      IF ( DIJ.GE.0.  .AND.  DIJ.GT.DSUP ) THEN
C                          ---------             --
C                         ON REGROUPE EGALEMENT SI DIJ = 0.
C
                          I1     = I
                          I2     = J
                          DSUP   = DIJ
C
                      ENDIF
C
                  ENDIF
C
              END DO
C
          ENDIF
C
      END DO
C
C
C     TOUTES LES SIMILARITES SONT NEGATIVES : FIN DE L'ALGORITHME
C     LES NUMEROS DES CLASSES SUR LA DIAGONALE SERONT CONSECUTIFS
C     ( AVEC CALCUL DU DEMI-COUT HORS DIAGONALE DE LA PARTITION )
C      ( MISE A JOUR DES TRIANGULAIRES SUPERIEURES DE Y ET SNN )
C     -----------------------------------------------------------
C
      IF ( I1 .EQ. 0 ) THEN
C
          DO I = 1 , N
              II     = I + (I-1)*N
              Y(II)  = IABS ( Y(II) )
          END DO
C
          K0     = 1
          DO NCL = 1 , N
              EFF    = 0
              DO I = 1 , N
                  II     = I + (I-1)*N
                  IF ( Y(II) .EQ. NCL ) THEN
                      Y(II)  = K0
                      EFF    = EFF + 1
                  ENDIF
              END DO
              IF ( EFF .NE. 0 ) K0     = K0 + 1
          END DO
C
          Z      = 0.
          BORNTH = 0.
          DO I = 1 , N
              DO J = 1 , I-1
                  IJ       = I + (J-1) * N
                  JI       = J + (I-1) * N
                  SNN (JI) = SNN (IJ)
                  Y   (JI) = Y   (IJ)
                  Z        = Z + Y(IJ) * SNN(IJ)
                  IF ( SNN(IJ) .GT. 0. ) BORNTH = BORNTH + SNN(IJ)
              END DO
          END DO
C
          RETURN
C
      ENDIF
C
C
C     I1 ET I2 ( I2 > I1 ) SONT LES PLUS PROCHES : ON LES REGROUPE
C     ------------------------------------------------------------
C     LE NOMBRE DE CLASSES DIMINUE DE 1 .
C
C     LE NUMERO DE LA CLASSE DE I1 EST AFFECTE EN NEGATIF A I2 ,
C     AINSI QU'AUX INDIVIDUS DE LA CLASSE DE I2 .
C
C     L'ELEMENT ( I1 , I2 ) DE LA MATRICE DE PARTITION VAUT 1 ,
C     AINSI QUE LES ELEMENTS ( E , I1 ) ET ( E , I2 ) TELS QUE
C     E  SOIT CLASSE , SOIT AVEC I1 , SOIT AVEC I2 .
C
C
      K                   =   K - 1
C
      NEWCLA              = - Y ( I1 + (I1-1)*N )
      ANCCLA              =   Y ( I2 + (I2-1)*N )
C
      DO I = 1 , N
          II     = I + (I-1)*N
          IF  (  Y(II) .EQ.  ANCCLA   .OR.
     .           Y(II) .EQ. -ANCCLA  )     Y(II) = NEWCLA
      END DO
C
      DO I = 1 , N
          II     = I + (I-1)*N
          IF  (  Y(II) .EQ.  NEWCLA   .OR.
     .           Y(II) .EQ. -NEWCLA  )     THEN
              DO J = 1 , I-1
                  JJ     = J + (J-1)*N
                  IF  (  Y(JJ) .EQ.  NEWCLA   .OR.
     .                   Y(JJ) .EQ. -NEWCLA  )     Y ( I + (J-1)*N ) = 1
              END DO
          ENDIF
      END DO
C
C
C     LES SIMILARITES DES AUTRES GROUPES AVEC I1 SONT RECALCULEES
C        DANS CE CAS PARTICULIER , LES SIMILARITES VERIFIENT :
C     SNN ( E , I1 U I2 )   =   SNN ( E , I1 )  +  SNN ( E , I2 )
C     -----------------------------------------------------------
C
      DO E = 1 , I1-1
          SNN ( E+(I1-1)*N ) = SNN ( E+(I1-1)*N ) + SNN ( E+(I2-1)*N )
      END DO
C
      DO E = I1+1 , I2-1
          SNN ( I1+(E-1)*N ) = SNN ( I1+(E-1)*N ) + SNN ( E+(I2-1)*N )
      END DO
C
      DO E = I2+1 , N
          SNN ( I1+(E-1)*N ) = SNN ( I1+(E-1)*N ) + SNN ( I2+(E-1)*N )
      END DO
C
C
C     ON RELANCE L'ALGORITHME
C     -----------------------
      GOTO 20
C
      END
C======================================================================C
C                                                                      C
C     ALGORITHME DE CLASSIFICATION : FAURE ET MALGRANGE BOOLEEN        C
C     ---------------------------------------------------------        C
C                                                                      C
C     EN ENTREE :                                                      C
C                 UECR         : UNITE D'ECRITURE DES RESULTATS        C
C                 FMBVR        : = .TRUE.  POUR LA SOLUTION EXACTE     C
C                                = .FALSE. POUR S'ARRETER A LA CAH     C
C                 TRIABS       : = .TRUE.  : TRI INITIAL VAL. ABSOLUE  C
C                                = .FALSE. : TRI INITIAL ALGEBRIQUE    C
C                 ALLSOL       : = .TRUE.  POUR TOUTES LES SOLUTIONS   C
C                                = .FALSE. POUR UNE SEULE SOLUTION     C
C                 N            : NOMBRE D'INDIVIDUS                    C
C                 COUTS  (N,N) : MATRICE DES COUTS ( SIGNES )          C
C                                                                      C
C     EN SORTIE :                                                      C
C                 YSAVE  (N,N) : SAUVEGARDE DE LA SOLUTION             C
C                 Y      (N,N) : MATRICE DE PARTITION FINALE           C
C                 RENUM  (N,N) : ADRESSE DES COUTS DES VARIABLES       C
C                 BORNTH       : MAJORANT DU COUT DES PARTITIONS       C
C                 NBCL0        : NOMBRE DE CLASSES INITIAL             C
C                 Z0           : COUT DE LA PARTITION INITIALE         C
C                 NBCL         : NOMBRE DE CLASSES FINAL               C
C                 Z            : COUT DE LA PARTITION FINALE           C
C                 NBEMP        : NOMBRE D'EMPILEMENTS                  C
C                 NBDEP        : NOMBRE DE DEPILEMENTS                 C
C                 NBSOL        : NOMBRE DE SOLUTIONS OPTIMALES         C
C                                SAUVEGARDEES APRES LA CAH             C
C                                                                      C
C     ATTENTION :                                                      C
C                 LA TRIANGULAIRE INFERIEURE DE RENUM CONTIENT LES     C
C                 ADRESSES DES COUTS DES M=N*(N-1)/2 VARIABLES DANS    C
C                 LA MATRICE DES COUTS                                 C
C                                                                      C
C                 LA TRIANGULAIRE SUPERIEURE DE RENUM CONTIENT LES     C
C                 ADRESSES RECIPROQUES DE CELLES DE LA TRIANGULAIRE    C
C                 INFERIEURE .                                         C
C                                                                      C
C                 LA TRIANGULAIRE INFERIEURE DE  Y  CONTIENT LES       C
C                 VALEURS  0  OU  1  CHOISIES POUR CHACUNE DES  M      C
C                 VARIABLES , OU  -1  SI LA VARIABLE N'EST PAS FIXEE . C
C                                                                      C
C                 LA TRIANGULAIRE SUPERIEURE DE  Y  CONTIENT L'        C
C                 ADRESSE DE LA VARIABLE PRECEDEMMENT FIXEE , OU  0    C
C                 POUR LA 1-ERE CHOISIE ; CE NUMERO EST NEGATIF SI     C
C                 LA VARIABLE EST CHOISIE PAR IMPLICATION .            C
C                                                                      C
C                 LA DIAGONALE DE Y CONTIENDRA LES NUMEROS DES CLASSES C
C                 LA DIAGONALE DE YSAVE AUSSI                          C
C                                                                      C
C                 LES ARGUMENTS COUTS ET YSAVE PEUVENT AVOIR LA MEME   C
C                 ADRESSE , A CONDITION QUE LES DECLARATIONS "REAL"    C
C                 ET "INTEGER" SUPPOSENT LE MEME NOMBRE DE MOTS :      C
C                 LES COUTS SONT DANS LA TRIANGULAIRE SUPERIEURE ,     C
C                 LA SAUVEGARDE DANS LA TRIANGULAIRE INFERIEURE .      C
C                                                                      C
C======================================================================C
C
C     FONCTION D'ADRESSAGE :
C     ----------------------------------------------------------------
C     $   ,         1 ,         2 ,       3   ,  . . . . . ,       N-1
C     1   ,         $ ,         N ,       N+1 ,            ,     2*N-3
C     2   ,         3 ,         $ ,                                  .
C     .                                                              .
C     .                                                              .
C     .                                          $         , N*(N-1)/2
C     N-1 ,     2*N-3 ,                          N*(N-1)/2 ,         $
C     ----------------------------------------------------------------
C     ADRSUP(I,J,N) = N*I - (I*(I+1))/2 + J - N
C     ADRINF(I,J,N) = N*J - (J*(J+1))/2 + I - N
C
C
C     ALGORITHME
C     ----------
C     ON ATTRIBUE PROGRESSIVEMENT LA VALEUR Y("K") = 1 , OU Y("K") = 0
C     POUR CHAQUE VARIABLE K , AFIN DE DEGRADER LE MOINS POSSIBLE LA
C     FONCTION ECONOMIQUE  Z  :  Y("K") = 1  SI SON COEFFICIENT DANS Z
C     EST POSITIF ( OU NUL ) ,  Y("K") = 0  SINON .
C     A CHAQUE ATTRIBUTION D'UNE VALEUR A LA VARIABLE K , ON EXAMINE
C     LES CONTRAINTES :
C     * SI LA VALEUR ATTRIBUEE EST REFUSEE , ON ATTRIBUE L'AUTRE VALEUR
C     * SI L'AUTRE VALEUR EST REFUSEE , ON REMET EN QUESTION LE DERNIER
C       CHOIX EFFECTUE .
C     * SI LA FONCTION ECONOMIQUE TOMBE EN DESSOUS DU COUT DE LA
C       SOLUTION SAUVEGARDEE , ON REMET EN QUESTION LE DERNIER CHOIX
C       EFFECTUE .
C     * SI ON EST AMENE A REMETTRE EN QUESTION TOUS LES CHOIX JUSQU'A
C       LA 1-ERE VARIABLE , ET QUE CELLE-CI EST ELLE MEME REFUSEE ,
C       L'ALGORITHME S'ARRETE : LA SOLUTION SAUVEGARDEE EST OPTIMALE .
C
C     ON STOCKE POUR CHAQUE VARIABLE , L'ADRESSE DU DERNIER CHOIX
C     EFFECTUE , AVEC UN SIGNE NEGATIF LORSQUE CELUI-CI A DEJA ETE
C     MODIFIE .
C
C======================================================================C
C
      SUBROUTINE PNKFMB ( UECR , FMBVR , TRIABS , ALLSOL , N ,
     ,                    COUTS , YSAVE , Y , RENUM ,
     ,                    BORNTH , NBCL0 , Z0 , NBCL , Z ,
     ,                    NBEMP , NBDEP , NBSOL )
C
      IMPLICIT INTEGER ( A - Z )
C
      INTEGER    YSAVE (N*N) , Y (N*N) , RENUM (N*N)
C
      REAL       COUTS (N*N) ,
     ,           BORNTH , Z0 , Z , DELTAZ , ZSAVE , ZNEW ,
     ,           FLOAT , ABS
C
      LOGICAL    FMBVR , TRIABS , ALLSOL , REFUS , CINTEG
C
C
C----------------------------------------------------------------------C
C
C
C     DETERMINATION DU TYPE DE COUTS : REELS OU ENTIERS
C     CINTEG N'EST UTILISE QU'A L'EDITION DES RESULTATS
C     -------------------------------------------------
      CINTEG = .TRUE.
      DO I = 1 , N*N
          ICOUTS = IFIX ( COUTS(I) )
          CINTEG = CINTEG  .AND.  COUTS(I) .EQ. FLOAT(ICOUTS)
      END DO
C
C
C     OBTENTION D'UNE PARTITION INITIALE PAR CAH
C     ------------------------------------------
      CALL PNKCAH ( N , COUTS , Y , NBCL0 , Z0 , BORNTH )
C
C
C     ECRITURE DE LA PARTITION INITIALE ET ARRET EVENTUEL
C     ---------------------------------------------------
      IF ( UECR .GT. 0 ) THEN
          IF ( CINTEG ) THEN
              WRITE (UECR,4001) IFIX (BORNTH) , IFIX (Z0) , NBCL0
          ELSE
              WRITE (UECR,4002)       BORNTH ,        Z0  , NBCL0
          ENDIF
          DO I = 1 , N
              WRITE (UECR,5000) I , Y ( I + (I-1)*N )
          END DO
      ENDIF
      IF ( .NOT. FMBVR ) RETURN
C
      DO I = 1 , N
          DO J = 1 , I-1
              IJ         = I + (J-1)*N
              YSAVE (IJ) = Y (IJ)
          END DO
      END DO
      ZSAVE  = Z0
C
C
C     TRI QUADRATIQUE DES COUTS : ARITHMETIQUE OU ALGEBRIQUE
C     EX-AEQUOS : ON TESTE LES ADRESSES DES ELEMENTS
C     --------------------------------------------------------------
C     LA VARIABLE K (K-EME PLUS GRAND COUT) ASSOCIEE AU COUT (I1,J1)
C     AURA COMME ADRESSE (IK,JK) DANS LA TRIANGULAIRE INFERIEURE
C     --------------------------------------------------------------
C
      DO J1 = 1 , N
          DO I1 = 1 , J1-1
C
              I1J1        = I1 + (J1-1) * N
              J1I1        = J1 + (I1-1) * N
              RANG        = 1
C
              DO 50 J2 = 1 , N
                  DO 50 I2 = 1 , J2-1
                      I2J2   = I2 + (J2-1) * N
                      IF ( TRIABS ) THEN
                          CDIF   = ABS(COUTS(I2J2)) - ABS(COUTS(I1J1))
                      ELSE
                          CDIF   =     COUTS(I2J2)  -     COUTS(I1J1)
                      ENDIF
                      IF ( CDIF ) 50 , 30 , 40
30                        IF ( I1J1 .GE. I2J2 ) GOTO 50
40                        RANG   = RANG + 1
50                    CONTINUE
C
              JK     = 1
60                FINJ   = N*JK - (JK*(JK+1))/2
                  IF ( RANG .GT. FINJ ) THEN
                      JK     = JK + 1
                      GOTO 60
                  ENDIF
              IK     = RANG + N - FINJ
              IKJK        = IK + (JK-1)*N
              RENUM(IKJK) = I1J1
              RENUM(I1J1) = IKJK
C
          END DO
      END DO
C
C
C     INITIALISATIONS DIVERSES ; Z EST LE MAJORANT , SAUF POUR K=M
C     ------------------------------------------------------------
      M      = ( N * (N-1) ) / 2
C
      DO I = 1 , N
          DO J = 1 , I-1
              Y ( I + (J-1)*N ) = -1
              Y ( J + (I-1)*N ) =  0
          END DO
          Y ( I + (I-1)*N ) = - 1
      END DO
C
      NBEMP  = 0
      NBDEP  = 0
      NAP    = 0
      NBSOL  = 0
      KIJPRE = 1
      I      = 1
      J      = 1
      K      = 0
      Z      = BORNTH
      REFUS  = .FALSE.
C
C
C     EMPILEMENT DE L'ADRESSE SUIVANTE : (I,J)+1
C     ------------------------------------------
1000  IF ( K .GE. M ) GOTO 1500
      NBEMP  = NBEMP + 1
      I      = I + 1
      IF ( I .GT. N ) THEN
          J      = J + 1
          I      = J + 1
      ENDIF
      IJ     = I + (J-1)*N
      JI     = J + (I-1)*N
      K      = K     + 1
C
C
C     COUT ZNEW = Z +/- DELTAZ ASSOCIE A LA VARIABLE (I,J) , I > J
C     ------------------------------------------------------------
      DELTAZ = COUTS ( RENUM (IJ) )
      IF ( DELTAZ .GE. 0. ) THEN
          VAL01  = 1
      ELSE
          VAL01  = 0
      ENDIF
C
C
C     CONTROLE DE VALIDITE DU CHOIX INITIAL , PUIS DU CHOIX INVERSE
C       ON N'INSISTE PAS SI LE MAJORANT Z EST INFERIEUR A ZSAVE
C     SI  REFUS = .TRUE.   AVANT CONTROLE  ,  ON VIENT DE DEPILER .
C     -------------------------------------------------------------
      CALL PNKTSY ( N , I , J , VAL01 , Y , RENUM , NAP , REFUS )
      IF ( REFUS ) THEN
          VAL01  = 1 - VAL01
          KIJPRE = - KIJPRE
          CALL PNKTSY ( N , I , J , VAL01 , Y , RENUM , NAP , REFUS )
          IF ( REFUS ) GOTO 1200
      ENDIF
1100  ZNEW   = Z
      IF ( VAL01 .EQ. 0 ) THEN
          IF ( DELTAZ .GT. 0. ) ZNEW = Z - DELTAZ
      ELSE
          IF ( DELTAZ .LT. 0. ) ZNEW = Z + DELTAZ
      ENDIF
      IF ( ALLSOL ) THEN
          IF ( ZNEW .LT. ZSAVE ) GOTO 1200
      ELSE
          IF ( ZNEW .LE. ZSAVE ) GOTO 1200
      ENDIF
C
C
C     ACCEPTATION DE LA K-EME VARIABLE : ECRITURE DE (I,J)
C     ----------------------------------------------------
      Y(IJ)  = VAL01
      Y(JI)  = KIJPRE
      KIJPRE = IJ
      Z      = ZNEW
      GOTO 1000
C
C
C     DEPILEMENT : ANNULATION DE (I,J)
C     --------------------------------
1200  NBDEP  = NBDEP + 1
      IF ( K .LE. 1 ) GOTO 2000
      K      = K     - 1
      I      = I     - 1
      IF ( I .LE. J ) THEN
          J      = J - 1
          I      =     N
      ENDIF
      IJ     = I + (J-1)*N
      JI     = J + (I-1)*N
      VAL01  = Y(IJ)
      KIJPRE = Y(JI)
      Y(IJ)  = - 1
      Y(JI)  =   0
      DELTAZ = COUTS ( RENUM (IJ) )
      IF ( VAL01 .EQ. 0 ) THEN
          IF ( DELTAZ .GT. 0. ) Z = Z + DELTAZ
      ELSE
          IF ( DELTAZ .LT. 0. ) Z = Z - DELTAZ
      ENDIF
      IF ( KIJPRE .LT. 0 ) GOTO 1200
C
C
C     ON ESSAIE L'AUTRE VALEUR
C     ------------------------
      VAL01  = 1 - VAL01
      KIJPRE = - KIJPRE
      CALL PNKTSY ( N , I , J , VAL01 , Y , RENUM , NAP , REFUS )
      IF ( REFUS ) GOTO 1200
      GOTO 1100
C
C
C     NOUVELLE SOLUTION
C     -----------------
1500  DO II = 1 , N
          DO JJ = 1 , II-1
              IJ           = II + (JJ-1)*N
              ISJS         = RENUM (IJ)
              JS           = ISJS / N
              IS           = ISJS - JS * N
              JS           = 1 + JS
              JSIS         = JS + (IS-1)*N
              YSAVE (JSIS) = Y (IJ)
          END DO
      END DO
      ZSAVE  = Z
      NBSOL  = NBSOL + 1
C
C
C     CALCUL DU NOMBRE DE CLASSES A PARTIR DE YSAVE
C     ---------------------------------------------
      DO IS = 1 , N
          YSAVE ( IS + (IS-1)*N ) = - 1
      END DO
      NBCL   = 0
      DO IS = 1 , N
          ISIS   = IS + (IS-1)*N
          IF ( YSAVE(ISIS) .LT. 0 ) THEN
              NBCL    = NBCL + 1
              DO JS = IS+1 , N
                  JSIS   = JS + (IS-1)*N
                  JSJS   = JS + (JS-1)*N
                  IF ( YSAVE(JSIS) .EQ. 1 ) YSAVE(JSJS) = NBCL
              END DO
              YSAVE(ISIS) = NBCL
          ENDIF
      END DO
C
C
C     ECRITURE DE LA PARTITION PROVISOIREMENT OPTIMALE
C     ------------------------------------------------
      IF ( UECR .GT. 0 ) THEN
          IF ( CINTEG ) THEN
              WRITE (UECR,6001) IFIX (BORNTH) , IFIX (Z) , NBCL ,
     ,                          NBEMP , NBDEP , NAP
          ELSE
              WRITE (UECR,6002)       BORNTH ,        Z  , NBCL ,
     ,                          NBEMP , NBDEP , NAP
          ENDIF
          DO IS = 1 , N
              WRITE (UECR,5000) IS , YSAVE ( IS + (IS-1)*N )
          END DO
      ENDIF
C
C
C     AU MIEUX , ON REEXAMINE K = M : SIMULATION DU REFUS DE K = M+1
C     --------------------------------------------------------------
      NBDEP  = NBDEP - 1
      K      = M + 1
C     I      = N
      J      = N
      GOTO 1200
C
C
C     RECUPERATION DE LA PARTITION OPTIMALE
C     -------------------------------------
2000  DO I = 1 , N
          DO J = 1 , I-1
              IJ     = I + (J-1)*N
              JI     = J + (I-1)*N
              Y (IJ) = YSAVE (IJ)
              Y (JI) = Y (IJ)
          END DO
      END DO
      Z      = ZSAVE
C
C
C     CALCUL DU NOMBRE DE CLASSES A PARTIR DE Y
C     -----------------------------------------
      NBCL   = 0
      DO I = 1 , N
          II     = I + (I-1)*N
          IF ( Y(II) .LT. 0 ) THEN
              NBCL    = NBCL + 1
              DO J = I+1 , N
                  IJ     = I + (J-1)*N
                  JJ     = J + (J-1)*N
                  IF ( Y(IJ) .EQ. 1 ) Y(JJ) = NBCL
              END DO
              Y(II)  = NBCL
          ENDIF
      END DO
C
C
C     ECRITURE DE LA PARTITION FINALE ET DES STATISTIQUES
C     ---------------------------------------------------
      IF ( UECR .GT. 0 ) THEN
          IF ( CINTEG ) THEN
              WRITE (UECR,7001) IFIX (BORNTH) , IFIX (Z) , NBCL ,
     ,                          NBEMP , NBDEP , NAP , NBSOL
          ELSE
              WRITE (UECR,7002)       BORNTH ,        Z  , NBCL ,
     ,                          NBEMP , NBDEP , NAP , NBSOL
          ENDIF
          DO I = 1 , N
              WRITE (UECR,5000) I , Y ( I + (I-1)*N )
          END DO
      ENDIF
C
      RETURN
C
C
C     FORMATS D'ECRITURE DES RESULTATS
C     --------------------------------
C
4001  FORMAT ( // ' ---------------------------------------------'
     ,          / ' MAXIMUM THEORIQUE  : DEMI-COUT =' , I13
     ,          / ' PARTITION INITIALE : DEMI-COUT =' , I13
     ,          / ' NOMBRE DE CLASSES  :            ' , I13
     ,          / ' ---------------------------------------------'
     ,         // '     --------      ------'
     ,          / '     INDIVIDU      CLASSE'
     ,          / '     --------      ------' )
C
4002  FORMAT ( // ' ---------------------------------------------'
     ,          / ' MAXIMUM THEORIQUE  : DEMI-COUT =' , E13.6
     ,          / ' PARTITION INITIALE : DEMI-COUT =' , E13.6
     ,          / ' NOMBRE DE CLASSES  :            ' , I13
     ,          / ' ---------------------------------------------'
     ,         // '     --------      ------'
     ,          / '     INDIVIDU      CLASSE'
     ,          / '     --------      ------' )
C
5000  FORMAT ( I13 , I12 )
C
6001  FORMAT ( // ' ---------------------------------------------'
     ,          / ' MAXIMUM THEORIQUE  : DEMI-COUT =' , I13
     ,          / ' PARTITION LOCALE   : DEMI-COUT =' , I13
     ,          / ' NOMBRE DE CLASSES  :            ' , I13
     ,          / ' EMPILEMENTS        :            ' , I13
     ,          / ' DEPILEMENTS        :            ' , I13
     ,          / ' TESTS CONTRAINTES  :            ' , I13
     ,          / ' ---------------------------------------------'
     ,         // '     --------      ------'
     ,          / '     INDIVIDU      CLASSE'
     ,          / '     --------      ------' )
C
6002  FORMAT ( // ' ---------------------------------------------'
     ,          / ' MAXIMUM THEORIQUE  : DEMI-COUT =' , E13.6
     ,          / ' PARTITION LOCALE   : DEMI-COUT =' , E13.6
     ,          / ' NOMBRE DE CLASSES  :            ' , I13
     ,          / ' EMPILEMENTS        :            ' , I13
     ,          / ' DEPILEMENTS        :            ' , I13
     ,          / ' TESTS CONTRAINTES  :            ' , I13
     ,          / ' ---------------------------------------------'
     ,         // '     --------      ------'
     ,          / '     INDIVIDU      CLASSE'
     ,          / '     --------      ------' )
C
7001  FORMAT ( // ' ---------------------------------------------'
     ,          / ' MAXIMUM THEORIQUE  : DEMI-COUT =' , I13
     ,          / ' PARTITION FINALE   : DEMI-COUT =' , I13
     ,          / ' NOMBRE DE CLASSES  :            ' , I13
     ,          / ' EMPILEMENTS        :            ' , I13
     ,          / ' DEPILEMENTS        :            ' , I13
     ,          / ' TESTS CONTRAINTES  :            ' , I13
     ,          / ' OPTIMUMS LOCAUX    :            ' , I13
     ,          / ' ---------------------------------------------'
     ,         // '     --------      ------'
     ,          / '     INDIVIDU      CLASSE'
     ,          / '     --------      ------' )
C
7002  FORMAT ( // ' ---------------------------------------------'
     ,          / ' MAXIMUM THEORIQUE  : DEMI-COUT =' , E13.6
     ,          / ' PARTITION FINALE   : DEMI-COUT =' , E13.6
     ,          / ' NOMBRE DE CLASSES  :            ' , I13
     ,          / ' EMPILEMENTS        :            ' , I13
     ,          / ' DEPILEMENTS        :            ' , I13
     ,          / ' TESTS CONTRAINTES  :            ' , I13
     ,          / ' OPTIMUMS LOCAUX    :            ' , I13
     ,          / ' ---------------------------------------------'
     ,         // '     --------      ------'
     ,          / '     INDIVIDU      CLASSE'
     ,          / '     --------      ------' )
C
      END
C======================================================================C
C                                                                      C
C     CONTROLE DE VALIDITE D'UNE NOUVELLE AFFECTATION DANS Y           C
C                        ( VOIR PNKFMB )                               C
C     ------------------------------------------------------           C
C                                                                      C
C     EN ENTREE :                                                      C
C                 N               : DIMENSION DE Y ET DE RENUM         C
C                 I               : INDICE DE LIGNE DU NOUVEL Y(I,J)   C
C                 J               : INDICE DE COLONNE DE Y(I,J)        C
C                 VAL01           : VALEUR PROPOSEE POUR Y(I,J)        C
C                 Y     ( N , N ) : MATRICE DE PARTITION ( DANS LA     C
C                                   TRIANGULAIRE INFERIEURE )          C
C                 RENUM ( N , N ) : MATRICE DES ADRESSES DES COUTS     C
C                 NAP             : NOMBRE D'APPELS                    C
C                                                                      C
C     EN SORTIE :                                                      C
C                 NAP             : NOMBRE D'APPELS + 1                C
C                 REFUS           : .TRUE.  SI ON REFUSE               C
C                                   .FALSE. SI ON ACCEPTE              C
C                                                                      C
C     ATTENTION :                                                      C
C                 LA TRIANGULAIRE INFERIEURE DE  RENUM  CONTIENT LE    C
C                 COUPLE (II,JJ) , ANCIENNE ADRESSE DE LA VARIABLE     C
C                 DANS LA TRIANGULAIRE SUPERIEURE , CORRESPONDANT      C
C                 AUX COUTS INITIAUX .                                 C
C                                                                      C
C                 LA TRIANGULAIRE SUPERIEURE DE  RENUM  CONTIENT LE    C
C                 COUPLE (I ,J ) , NOUVELLE ADRESSE DE LA VARIABLE     C
C                 DANS LA TRIANGULAIRE INFERIEURE , APRES CLASSEMENT   C
C                 PAR ORDRE DECROISSANT : VOIR CALREN .                C
C                                                                      C
C======================================================================C
C
      SUBROUTINE PNKTSY ( N , I , J , VAL01 , Y , RENUM , NAP , REFUS )
C
      IMPLICIT INTEGER ( A - Z )
C
      LOGICAL    REFUS
C
C     INTEGER    Y     ( N , N ) , RENUM ( N , N )
      INTEGER    Y     (   *   ) , RENUM (   *   )
C
C
      NAP    = NAP + 1
      REFUS  = .FALSE.
C
C
C     EXTRACTION DES INDICES II ET JJ > II , ASSOCIES A YIJ INITIAL
C     -------------------------------------------------------------
      JJII     = RENUM ( I + (J-1)*N )
      IIM1     = (JJII-1) / N
      II       = IIM1 + 1
      JJ       = JJII - N * IIM1
C     Y(II,JJ) = VAL01
C
C
C     BOUCLE SUR LES INDICES INITIAUX COHERENTS AVEC YIJ , YIK , YJK
C     --------------------------------------------------------------
      DO 100 KK = 1 , N
C
          IF ( II - KK ) 10 , 100 , 20
10        YIK    = Y ( RENUM ( II + (KK-1)*N ) )
          GOTO 30
20        YIK    = Y ( RENUM ( KK + (II-1)*N ) )
30        IF ( JJ - KK ) 40 , 100 , 50
40        YJK    = Y ( RENUM ( JJ + (KK-1)*N ) )
          GOTO 60
50        YJK    = Y ( RENUM ( KK + (JJ-1)*N ) )
C
C         CONTRAIREMENT A LA PROGRAMMATION LINEAIRE , ON TESTE
C         TROIS PAR TROIS LES CONTRAINTES  YIJ + YIK - YJK < 2
C         ----------------------------------------------------
C         REFUS  : YIJ , YIK , YJK  ( VALEURS POSSIBLES -1 , 0 , +1 )
C                   1     1     0
C                   1     0     1
C                   0     1     1
C
60        REFUS  =  VAL01+YIK+YJK  .EQ.  2
C
          IF ( REFUS ) RETURN
C
100       CONTINUE
C
      RETURN
C
      END