Numérotation des lignes :

chemin
C CHEMIN    SOURCE    PASCAL    22/02/24    21:15:02     11298                SUBROUTINE CHEMIN(MELEME,IP1,IP2,IPT1)      IMPLICIT INTEGER(I-N) -INC PPARAM-INC CCOPTIO-INC SMELEME-INC SMCOORD      SEGMENT ICPR(nbpts)      SEGMENT IPRI(nbpts)      SEGMENT INEG(nbpts)      SEGMENT KON(MAXVOI,NPO)      SEGMENT IVOI(MAXVOI,NPO)      SEGMENT ILKON(NPO)      SEGMENT ICHEM         INTEGER NIVE(NPO+2)         INTEGER INOE(NPO)         INTEGER IPERE(nbpts)      ENDSEGMENT      SEGINI ICPR      NPOIN=0      I1=1      I2=2      SEGACT MELEME      NBELEM=NUM(/2)      IF(ITYPEL.NE.2.AND.ITYPEL.NE.3) THEN        CALL ERREUR(16)        SEGDES MELEME        RETURN      ENDIF      IF(ITYPEL.EQ.3) I2=3**  en entree MELEME est suppose ne contenir que des elements de meme*  type. Soit des seg2 soit des seg3. ICPR(I)=J l'ancien Ieme noeud* est le Jeme local**   comptage des voisins*      DO 1 I=1,NUM(/2)      IJ= NUM(I1,I)      ICPR(IJ)=ICPR(IJ)+1      IJ= NUM(I2,I)      ICPR(IJ)=ICPR(IJ)+1   1  CONTINUE      IF(ICPR(IP1).EQ.0.OR.ICPR(IP2).EQ.0) THEN         CALL ERREUR(866)         RETURN      ENDIF      MAXVOI=0      NPO=0      DO 2 I=1,ICPR(/1)      IF(ICPR(I).NE.0) THEN         MAXVOI=MAX(MAXVOI,ICPR(I))         NPO=NPO+1         ICPR(I)=NPO      ENDIF    2 CONTINUE** fabrication du tableau KON(I,J)=k le iémé noeud connecté au noeud* J est le Keme noeud      SEGINI KON,ILKON,IVOI      DO 3 I=1,NUM(/2)      IA=NUM(I1,I)      IB=NUM(I2,I)      IACP=ICPR(IA)      IBCP=ICPR(IB)      ILKON(IACP)=ILKON(IACP)+1      ILKON(IBCP)=ILKON(IBCP)+1      KON(ILKON(IACP),IACP)=IB      KON(ILKON(IBCP),IBCP)=IA      IVOI(ILKON(IACP),IACP)=I      IVOI(ILKON(IBCP),IBCP)=I   3  CONTINUE** on demarre l'arbre en partant du point IP2*      SEGINI ICHEM,IPRI,INEG      IDEP=IP2      IPLA=1      INUM=1      NIVE(1)=1      NIVE(2)=2      INOE(IPLA)=IP2      IPRI(IP2)=1      IPERE(IP2)=0      IDER=0      IAV=0  100 CONTINUE      IF(IDER.EQ.1) GO TO 101      IF(IPLA.EQ.IAV) GO TO 101      IAV=IPLA      IF(IPLA.GE.NPO) IDER=1      IDEB=NIVE(INUM)      IFIN=NIVE(INUM+1)-1      DO 104 I=IDEB,IFIN         IA=INOE(I)         IC=IPERE(IA)         DO 105 J=1,ILKON(ICPR(IA))            IB=KON(J,ICPR(IA))            IF(IB.EQ.IC) GO TO 105            if (ib.eq.0) goto 105            IF(IPRI(IB).EQ.0) THEN                IPLA=IPLA+1                INOE(IPLA)=IB                IPRI(IB)=INUM+1                IPERE(IB)=IA             ELSE** on remonte le long des deux branches pour trouver la partie commune*                J1=IA                J2=IB                L1=IPRI(IA)                L2=IPRI(IB)                IF(L1.LT.L2) THEN                    J2=IPERE(J2)                    L2=IPRI(J2)                ENDIF                IF(L1.GT.L2) THEN                     J1=IPERE(J1)                     L1=IPRI(J1)                ENDIF  106           CONTINUE                IF(J2.NE.J1) THEN                   J1=IPERE(J1)                   J2=IPERE(J2)                   GO TO 106                ELSE                   INEG(J2)=1                ENDIF            ENDIF 105     CONTINUE 104  CONTINUE      INUM=INUM+1      NIVE(INUM+1)=IPLA+1      GO TO 100 101  CONTINUE      IF(IPRI(IP1).EQ.0) THEN        CALL ERREUR(868)        SEGDES MELEME        SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI        RETURN      ENDIF      IF(INEG(IP2).EQ.1) THEN        CALL ERREUR(867)        SEGDES MELEME        SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI        RETURN      ENDIF** on recommence l'arbre mais on met en negatif toutes les cycles*      DO 199 I=1,IPRI(/1)        IPRI(I)=0  199 CONTINUE      IPLA=1      INUM=1      NIVE(1)=1      NIVE(2)=2      INOE(IPLA)=IP2      IPRI(IP2)=1      IPERE(IP2)=0      IAV=0  200 CONTINUE      IF(IPLA.GE.NPO) GO TO 201      IF(IPLA.EQ.IAV) GO TO 201      IAV=IPLA      IDEB=NIVE(INUM)      IFIN=NIVE(INUM+1)-1      DO 204 I=IDEB,IFIN         IA=INOE(I)         IC=IPERE(IA)         ID=INEG(IA)         DO 205 J=1,ILKON(ICPR(IA))            IB=KON(J,ICPR(IA))            IF(IB.EQ.IC) GO TO 205            IF(IB.EQ.0) GO TO 205            IF(IPRI(IB).EQ.0) THEN                IPLA=IPLA+1                INOE(IPLA)=IB                IPRI(IB)=INUM+1                IPERE(IB)=IA                IF(ID.GT.0) INEG(IB)=1            ENDIF 205     CONTINUE 204  CONTINUE      INUM=INUM+1      NIVE(INUM+1)=IPLA+1      GO TO 200  201 CONTINUE**   si ineg(IP1)=0  la tache est possible sinon retour*      IF(INEG(IP1).EQ.1)THEN        CALL ERREUR(867)        SEGDES MELEME        SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI        RETURN      ENDIF      NBELEM=IPRI(IP1)-1      NBNN = NUM(/1)      NBSOUS=0      NBREF=0      SEGINI IPT1      IPT1.NUM(1,1)=IP1      IPA=IP1      IPO=1  302 CONTINUE      IB=IPERE(IPA)      DO 303 I=1,ILKON(ICPR(IPA))        IF(IB.NE.KON(I,ICPR(IPA)))  GO TO 303        IV=IVOI (I,ICPR(IPA))        IF(NBNN.EQ.3) IPT1.NUM(2,IPO)=NUM(2,IV)        IPT1.ICOLOR(IPO)=ICOLOR(IV)        IPT1.NUM(I2,IPO)=IB        IF(IB.NE.IP2)  THEN            IPA=IB            IPO=IPO+1            IPT1.NUM(1,IPO)=IB            GO TO 302        ENDIF        GO TO 304  303 CONTINUE      CALL ERREUR(21)      RETURN  304 CONTINUE      IPT1.ITYPEL=I2      SEGDES IPT1,MELEME      SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI      RETURN      END      

© Cast3M 2003 - Tous droits réservés.
Mentions légales