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