Esope source files

   1 : C VTOP2D    SOURCE    PV        14/02/04    21:15:00     7940           
   2 :        SUBROUTINE VTOP2D(meleme)
   3 :        IMPLICIT INTEGER(I-N)
   4 :        IMPLICIT REAL*8(A-H,O-Z)
   5 : 
   6 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   7 : C
   8 : C     Appelée par VERMAI
   9 : C
  10 : C     vérifie qu'il n'y a pas d'éléments de degré un accolé à un
  11 : C     élément de degré 2.
  12 : C
  13 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  14 : C
  15 : C     Modifications :
  16 : C
  17 : C       P. Maugis (04/08/2005) :
  18 : C         on lieu de faire une erreur sur une sous-zone non pertinente,
  19 : C         on passe à la sous-zone suivante
  20 : C
  21 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  22 : -INC CCOPTIO
  23 : -INC CCGEOME
  24 : -INC SMELEME
  25 : -INC SMCOORD
  26 : C
  27 :         SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  28 :         SEGMENT IDCP(ITE)
  29 :         SEGMENT INTER
  30 :                 INTEGER INTE(NBSOUS)
  31 :         ENDSEGMENT
  32 :         SEGMENT KON(NBCON,NMAX,3)
  33 :         CHARACTER*6 CHAIN1
  34 :         CHARACTER*6 CHAIN2
  35 : C
  36 :         IPT8=MELEME
  37 :         SEGACT MELEME
  38 :         SEGINI ICPR
  39 : c
  40 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  41 : C
  42 : C       Création d'un tableau de connexions :
  43 : C               comme la numérotation des noeuds est aléatoire, on
  44 : C       utilise un vecteur réduit (de dimension le nombre de noeuds ITE)
  45 : C       noté ICPR qui renumérote les noeuds.
  46 : C               1 point final connecté
  47 : C               2 point intermédiaire éventuel (si de deg3) et sens
  48 : C
  49 : C       Si un point est connecté à la fois à un autre point par un
  50 : C       élément de degré 2 et un élément de degré 3, il apparait deux
  51 : C       fois dans la meme ligne du tableau.
  52 : C
  53 : 
  54 : C       ICPR contient le numéro du noeud intéressant à traiter,
  55 : C       ou 0 s'il n'a aucune connection.
  56 :         ITE=0
  57 :         IPT1=MELEME
  58 :         DO 3 I=1,MAX(1,LISOUS(/1))
  59 :           IF (LISOUS(/1).NE.0) THEN
  60 :             IPT1=LISOUS(I)
  61 :             SEGACT IPT1
  62 :           ENDIF
  63 :           K=IPT1.ITYPEL
  64 :           IF (K.EQ.KDEGRE(K)) THEN
  65 : *           On ne veut pas de POI1, SEG2 ni SEG3
  65 : *            CALL ERREUR(16)
  66 : *            RETURN
  67 :             IF (LISOUS(/1).NE.0) SEGDES IPT1
  68 :             GOTO 3
  69 :           ENDIF
  70 : 
  71 :           IDEP=NSPOS(K)
  72 :           IF (NBSOM(K).GT.0) THEN
  73 :             IFEP=IDEP+NBSOM(K)-1
  74 :           ELSE
  75 : C           Cas du polygone
  76 :             IFEP=IDEP+IPT1.NUM(/1)-1
  77 :           ENDIF
  78 :           IF (IDEP.GT.IFEP) THEN
  79 :             write(IOIMP,*) 'Une face doit avoir au moins 3 points'
  79 :             CALL ERREUR (16)
  80 :             RETURN
  81 :           ENDIF
  82 : 
  83 :           DO 4 JJ=IDEP,IFEP
  84 :             J=IBSOM(JJ)
  85 :             DO 7 K=1,IPT1.NUM(/2)
  86 :               IPOIT=IPT1.NUM(J,K)
  87 :               IF (ICPR(IPOIT).NE.0) GOTO 7
  88 :               ITE=ITE+1
  89 :               ICPR(IPOIT)=ITE
  90 :    7        CONTINUE
  91 :    4      CONTINUE
  92 :           IF (LISOUS(/1).NE.0) SEGDES IPT1
  93 :    3    CONTINUE
  94 :         SEGDES MELEME
  95 : C
  96 :         IF (ITE.EQ.0) THEN
  97 : *         Aucun element n a de point sommet
  98 :           SEGSUP ICPR
  98 : *          CALL ERREUR(16)
  99 :           RETURN
 100 :         ENDIF
 101 : C
 102 : C       on initialise le tableau de connexions
 103 : C       on définit les paramètres
 104 : C
 105 :         NBCON=7
 106 :         NBCONR=NBCON-1
 107 :         NMAX=(10*ITE)/NBCON
 108 :         SEGINI KON
 109 : C
 110 : C       Mise à zéro du tableau kon
 111 : C
 112 :         DO 10 K=1,3
 113 :            DO 10 I=1,NMAX
 114 :               DO 10 J=1,NBCON
 115 :   10    KON(J,I,K)=0
 116 : C
 117 : C
 118 : C       on remplit le tableau :
 119 : C       la 1ère coordonnée est le n° du noeud final
 120 : C       la 2ème est le n° du noeud intermédiare éventuel
 121 : C       (sinon 1) et le sens (signe)
 122 : C       la 3ème code la couleur
 123 : C
 124 :         ICHAIN=ITE
 125 :         SEGACT MELEME
 126 :         IPT1=MELEME
 127 :         K1=0
 128 :         K2=0
 129 :         NBSOUS=LISOUS(/1)+1
 130 :         SEGINI INTER
 131 :         IF (LISOUS(/1).NE.0) THEN
 132 :           DO 300 IO=1,LISOUS(/1)
 133 :             IPT2=LISOUS(IO)
 134 :             SEGACT IPT2
 135 :             K=IPT2.ITYPEL
 136 :             SEGDES IPT2
 137 :             IF (K.EQ.KDEGRE(K)) THEN
 138 : *             On ne veut pas de POI1, SEG2 ni SEG3
 138 : *              CALL ERREUR(16)
 139 : *              RETURN
 140 :               GOTO 300
 141 :             ENDIF
 142 : 
 143 : C           LE NOMBRE DE FACE EST 1 QUEL EST SON TYPE
 144 : C
 145 : C           ON ORDONNE LES SOUS OBJETS : LES SOUS OBJ DE DEGRE 3 D'ABORD
 146 : C           LES AUTRES ENSUITES
 147 :             NBNN=KDEGRE(K)
 148 :             IF (NBNN.EQ.3) THEN
 149 :               K1=K1+1
 150 :               INTE(K1)=LISOUS(IO)
 151 :             ELSE
 152 :               K2=K2+1
 153 :               INTE(LISOUS(/1)-K2+1)=LISOUS(IO)
 154 :             ENDIF
 155 :  21         CONTINUE
 156 :  300      CONTINUE
 157 :         ELSE
 158 :           INTE(1)=MELEME
 159 :         ENDIF
 160 : 
 161 :         DO 30 IO=1,MAX(1,LISOUS(/1))
 162 :           IPT1=INTE(IO)
 163 :           SEGACT IPT1
 164 :           K=IPT1.ITYPEL
 165 :           IF (K.EQ.KDEGRE(K)) THEN
 166 : *           On ne veut pas de POI1, SEG2 ni SEG3
 166 : *            CALL ERREUR(16)
 167 : *            RETURN
 168 :             IF (LISOUS(/1).NE.0) SEGDES IPT1
 169 :             GOTO 30
 170 :           ENDIF
 171 : 
 172 :           NBFA=LTEL(1,K)
 173 :           IF (NBFA.EQ.0) THEN
 174 : *           données incompatibles
 175 : *            Ces elements n'ont pas de face.
 175 : *            CALL ERREUR(21)
 176 : *            RETURN
 177 :             GOTO 30
 178 :           ENDIF
 179 : 
 180 :          KK=LTEL(2,K)
 181 :          NBNN=KDEGRE(K)
 182 :          IPAS=NBNN-1
 183 :          DO 301 K1=1,NBFA
 184 :            ITYP=LDEL(1,KK+K1-1)
 185 :            IDEP=LDEL(2,KK+K1-1)
 186 :            IF (ITYP.NE.6) THEN
 187 :              IFEP=IDEP+KDFAC(1,ITYP)-1
 188 :            ELSE
 189 : C            Cas du polygone
 190 :              IFEP= IDEP+IPT1.NUM(/1)-1
 191 :            ENDIF
 192 :            DO 22 I=1,IPT1.NUM(/2)
 193 :              DO 22 J=IDEP,IFEP,IPAS
 194 :                NMIL=1
 195 :                N1=ICPR(IPT1.NUM(LFAC(J),I))
 196 :                JSUIV=J+IPAS
 197 :                IF (JSUIV.GT.IFEP) JSUIV=IDEP
 198 :                N2=ICPR(IPT1.NUM(LFAC(JSUIV),I))
 199 :                IF (IPAS.EQ.2)  THEN
 200 :                  NMIL=IPT1.NUM(LFAC(J+1),I)
 201 :                  IF (ICPR(NMIL).NE.0) THEN
 202 :                    NMIL=ICPR(NMIL)
 203 :                  ELSE
 204 :                    NMIL=0
 205 :                  ENDIF
 206 :                ENDIF
 207 :                NI=N1
 208 :                NJ=N2
 209 :                IF ((N1.EQ.0).OR.(N2.EQ.0)) THEN
 210 : *                Tache impossible. Probablement données erronées
 210 :                  CALL ERREUR(26)
 211 :                  SEGSUP KON,ICPR
 212 :                  SEGDES MELEME
 213 :                  RETURN
 214 :                ENDIF
 215 :                KSCOL=IPT1.ICOLOR(I)
 216 :                IPO=0
 217 :   23         CONTINUE
 218 :              KINT=1
 219 : 
 220 :   251        CONTINUE
 221 :   24         DO 25 K=KINT,NBCONR
 222 :                IF (KON(K,NI,1).EQ.0) GOTO 26
 223 :                IF (KON(K,NI,1).EQ.NJ) GOTO 27
 224 :   25         CONTINUE
 225 : 
 226 :              IF (KON(NBCON,NI,1).EQ.0) GOTO 28
 227 :              NI=KON(NBCON,NI,1)
 228 :              KINT=1
 229 :              GOTO 24
 230 :   27         IF (ABS(NMIL).EQ.1) THEN
 231 :                IF (ABS(KON(K,NI,2)).NE.1) THEN
 232 :                  KINT=K+1
 233 :                  GOTO 251
 234 :                ENDIF
 235 :              ENDIF
 236 :              GOTO 29
 237 : 
 238 :   26         KON(K,NI,1)=NJ
 239 :              KON(K,NI,2)=NMIL
 240 :              KON(K,NI,3)=KSCOL
 241 :              GOTO 29
 242 : 
 243 :   28         ICHAIN=ICHAIN+1
 244 :              IF (ICHAIN.GE.NMAX) THEN
 245 :                NMAX = NMAX * 2
 246 :                SEGADJ KON
 247 :              ENDIF
 248 :              KON(NBCON,NI,1)=ICHAIN
 249 :              K=1
 250 :              NI=ICHAIN
 251 :              GOTO 26
 252 : 
 253 :   29         IF (IPO.EQ.1) GOTO 22
 254 :                NMIL=-NMIL
 255 :                NI=N2
 256 :                NJ=N1
 257 :                IPO=1
 258 :              GOTO 23
 259 :   22    CONTINUE
 260 :   301 CONTINUE
 261 :       SEGDES IPT1
 262 :   30  CONTINUE
 263 : 
 264 :       SEGSUP INTER
 265 :       IF (IIMPI.EQ.2) THEN
 266 :         WRITE (IOIMP,1122)
 267 :      #        (((KON(I,J,K),K=1,2),I=1,NBCON),J=1,NMAX)
 268 :  1122   FORMAT(1X,14I5)
 269 :       ENDIF
 270 :       SEGDES MELEME
 271 : C
 272 : C
 273 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 274 : C
 275 : C
 276 : C       Création de idcp
 277 : C               Vecteur permettant de revenir à la numérotation initiale
 278 : C
 279 :       SEGINI IDCP
 280 :       DO 40 I=1,ICPR(/1)
 281 :         IF (ICPR(I).EQ.0) GOTO 40
 282 :         IDCP(ICPR(I))=I
 283 :   40  CONTINUE
 284 :       SEGSUP ICPR
 285 : C
 286 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 287 : C
 288 : C       ECRITURE DE L'AVERTISSEMENT
 289 : C
 290 : C       Deux cas de figures possibles :
 291 : C               un élément de degré 3 et un élément de degré 2 sont
 292 : C       connectés par leus extrémités (ITEST1)
 293 : C               deux éléments de degré 2 sont connectés aux trois
 294 : C       points d'un élément de degré 3
 295 : C
 296 : C
 297 :       NNOEUD=0
 298 :       DO 50 NI=1,ITE
 299 : C
 300 : C       Recherche du nombre de connexions d'un noeud et des numéros de lignes
 301 : C       où sont stockées les n° des noeuds connectés
 302 : C
 303 : C       COMPTEUR compte le nombre de lignes utilisées pour enregistrer le
 304 : C       nombre de noeuds connectés au noeud n° NI
 305 : C
 306 : C       NKON est le nombre de noeuds connectés dans la dernière ligne
 307 : C
 308 :       NINT=NI
 309 :       icompt=1
 310 : 
 311 :   90  CONTINUE
 312 :       iAD=KON(NBCON,NINT,1)
 313 :       IF (iAD.NE.0) THEN
 314 :         NINT=iAD
 315 :         INTEG=icompt
 316 :         icompt=INTEG+1
 317 :         GOTO 90
 318 :       ELSE
 319 :         J=0
 320 :   91    CONTINUE
 321 :         J=J+1
 322 :         IF (KON(J,NINT,1).NE.0) THEN
 323 :           GOTO 91
 324 :         ENDIF
 325 :         NKON=J-1
 326 :       ENDIF
 327 : C
 328 : C     Recherche du dernier noeud qui constitue un élément de degré 3
 329 : C
 330 :       I=0
 331 :       NINT=NI
 332 : 
 333 :   92  CONTINUE
 334 :       I=I+1
 335 :       jcompt=-1
 336 :       IF (I.LE.icompt) THEN
 337 :         J=0
 338 :   93    CONTINUE
 339 :         J=J+1
 340 :         IF (J.LE.NBCONR) THEN
 341 :           IF (KON(J,NINT,1).EQ.0) GOTO 50
 342 :           IF (ABS(KON(J,NINT,2)).NE.1) GOTO 93
 343 :           NCOMPT=NINT
 344 :           jcompt=J-1
 345 :         ELSE
 346 :           NINT=KON(NBCON,NINT,1)
 347 :           GOTO 92
 348 :         ENDIF
 349 :       ENDIF
 350 : C
 351 : C     Lecture du tableau de connexions et comparaison
 352 : C
 353 : C     CAS OU LES ELEMENTS ONT LA MEME TAILLE
 354 : C
 355 :       iadi=NI
 356 :       IF (I.EQ.1) GOTO 100
 357 :       DO 52 LI=1,I-1
 358 :         DO 53 J=1,NBCONR
 359 :           ITEST1=KON(J,iadi,1)
 360 :           ITEST2=KON(J,iadi,2)
 361 :           IF (ITEST2.LT.0) GOTO 53
 362 :           JJ=jcompt
 363 :           IF (I.EQ.icompt) GOTO 98
 364 :           if (jcompt.lt.0) goto 53
 365 :   94      CONTINUE
 366 :           JJ=JJ+1
 367 :           IF (JJ.LE.NBCONR) THEN
 368 :             IF (KON(JJ,NCOMPT,2).LT.0) GOTO 94
 369 :             IF (ITEST1.NE.KON(JJ,NCOMPT,1)) GOTO 94
 370 :             ipoin1=IDCP(NI)
 371 :             ipoin2=IDCP(ITEST1)
 371 :             CALL ETEST1(ipoin1,ipoin2,NNOEUD)
 372 :             IDCP(NI)=ipoin1
 373 :             IDCP(ITEST1)=ipoin2
 374 :             GOTO 53
 375 :           ENDIF
 376 : C
 377 : C         Cas où il ya plus de deux lignes de connections pour un noeud
 378 : C
 379 :           NINT=NCOMPT
 380 :           IF (I.LE.icompt-1) THEN
 381 :             II=I
 382 :   96        CONTINUE
 383 :             II=II+1
 384 :             NINT=KON(NBCON,NINT,1)
 385 :             IF (II.LE.icompt-1) THEN
 386 :               JJ=0
 387 :   97          CONTINUE
 388 :               JJ=JJ+1
 389 :               IF (JJ.LE.NBCONR) THEN
 390 :                 IF (KON(JJ,NINT,2).LT.0) GOTO 97
 391 :                 IF (ITEST1.NE.KON(JJ,NINT,1)) GOTO 97
 392 :                 ipoin1=IDCP(NI)
 393 :                 ipoin2=IDCP(ITEST1)
 393 :                 CALL ETEST1(ipoin1,ipoin2,NNOEUD)
 394 :                 IDCP(NI)=ipoin1
 395 :                 IDCP(ITEST1)=ipoin2
 396 :                 GOTO 53
 397 :               ENDIF
 398 :               GOTO 96
 399 :             ENDIF
 400 :           ENDIF
 401 : C
 402 : C         On finit de lire la ligne
 403 : C
 404 :           NINT=KON(NBCON,NINT,1)
 405 :           JJ=0
 406 :  98       CONTINUE
 407 :           JJ=JJ+1
 408 :           IF (JJ.LE.NKON) THEN
 409 :             IF (KON(JJ,NINT,2).LT.0) GOTO 98
 410 :             IF (ITEST1.NE.KON(JJ,NINT,1)) GOTO 98
 411 :             ipoin1=IDCP(NI)
 412 :             ipoin2=IDCP(ITEST1)
 412 :             CALL ETEST1(ipoin1,ipoin2,NNOEUD)
 413 :             IDCP(NI)=ipoin1
 414 :             IDCP(ITEST1)=ipoin2
 415 :             GOTO 53
 416 :           ENDIF
 417 :   53    CONTINUE
 418 :         iadi=KON(NBCON,iadi,1)
 419 :   52  CONTINUE
 420 : C
 421 : C
 422 :   100 CONTINUE
 423 :       DO 54 J=1,jcompt
 424 :         ITEST1=KON(J,NCOMPT,1)
 425 :         ITEST2=KON(J,NCOMPT,2)
 426 :         IF (ITEST2.LT.0) GOTO 54
 427 :           JJ=jcompt
 428 :           IF (I.EQ.icompt) GOTO 198
 429 :   194     CONTINUE
 430 :           JJ=JJ+1
 431 :           IF (JJ.LE.NBCONR) THEN
 432 :             IF (KON(JJ,NCOMPT,2).LT.0) GOTO 194
 433 :             IF (ITEST1.NE.KON(JJ,NCOMPT,1)) GOTO 194
 434 :             ipoin1=IDCP(NI)
 435 :             ipoin2=IDCP(ITEST1)
 435 :             CALL ETEST1(ipoin1,ipoin2,NNOEUD)
 436 :             IDCP(NI)=ipoin1
 437 :             IDCP(ITEST1)=ipoin2
 438 :             GOTO 54
 439 :          ENDIF
 440 : C
 441 : C        Cas où il ya plus de deux lignes de connections pour un noeud
 442 : C
 443 :          NINT=NCOMPT
 444 :          IF (I.LT.icompt-1) THEN
 445 : 
 446 :            II=I
 447 :   196      CONTINUE
 448 :            II=II+1
 449 :            NINT=KON(NBCON,NINT,1)
 450 :            IF (II.LE.icompt-1) THEN
 451 :              JJ=0
 452 :  197         CONTINUE
 453 :              JJ=JJ+1
 454 :              IF (JJ.LE.NBCONR) THEN
 455 :                IF (KON(JJ,NINT,2).LT.0) GOTO 197
 456 :                IF (ITEST1.NE.KON(JJ,NINT,1)) GOTO 197
 457 :                ipoin1=IDCP(NI)
 458 :                ipoin2=IDCP(ITEST1)
 458 :                CALL ETEST1(ipoin1,ipoin2,NNOEUD)
 459 :                IDCP(NI)=ipoin1
 460 :                IDCP(ITEST1)=ipoin2
 461 :                GOTO 54
 462 :              ENDIF
 463 :              GOTO 196
 464 :            ENDIF
 465 :          ENDIF
 466 : C
 467 : C        On finit de lire la ligne
 468 : C
 469 : 
 470 :          NINT=KON(NBCON,NINT,1)
 471 :          JJ=0
 472 :  198     CONTINUE
 473 :          JJ=JJ+1
 474 :          IF (JJ.LE.NKON) THEN
 475 :            IF (KON(JJ,NINT,2).LT.0) GOTO 198
 476 :            IF (ITEST1.NE.KON(JJ,NINT,1)) GOTO 198
 477 :              ipoin1=IDCP(NI)
 478 :              ipoin2=IDCP(ITEST1)
 478 :              CALL ETEST1(ipoin1,ipoin2,NNOEUD)
 479 :              IDCP(NI)=ipoin1
 480 :              IDCP(ITEST1)=ipoin2
 481 :              GOTO 54
 482 :            ENDIF
 483 :  54     CONTINUE
 484 : C
 485 : C       CAS OU IL Y A DEUX SEG2 POUR UN SEG3
 486 : C
 487 :         iadi=NI
 488 :         IF (I.EQ.1) GOTO 200
 489 :         DO 252 LI=1,I-1
 490 :           DO 253 J=1,NBCONR
 491 :             ITEST1=KON(J,iadi,1)
 492 :             ITEST2=KON(J,iadi,2)
 493 :             IF (ITEST2.LE.0) GOTO 253
 494 :             JJ=jcompt
 495 :             WRITE(IOIMP, *)I
 496 :             WRITE(IOIMP,*)icompt
 497 :             IF (I.EQ.icompt) GOTO 298
 498 :  294        CONTINUE
 499 :             JJ=JJ+1
 500 :             IF (JJ.LE.NBCONR) THEN
 501 :               IF (ITEST2.NE.KON(JJ,NCOMPT,1)) GOTO 294
 502 :               ipoin1=IDCP(NI)
 503 :               ipoin2=IDCP(ITEST2)
 504 :               ipoin3=IDCP(ITEST1)
 504 :               CALL ETEST2(ipoin1,ipoin2,ipoin3,NNOEUD)
 505 :               IDCP(NI)=ipoin1
 506 :               IDCP(ITEST2)=ipoin2
 507 :               IDCP(ITEST1)=ipoin3
 508 :               GOTO 253
 509 :             ENDIF
 510 : C
 511 : C           Cas où il ya plus de deux lignes de connections pour un noeud
 512 : C
 513 :             NINT=NCOMPT
 514 :             IF (I.LE.icompt-1) THEN
 515 :               II=I
 516 :  296          CONTINUE
 517 :               II=II+1
 518 :               NINT=KON(NBCON,NINT,1)
 519 :               IF (II.LE.icompt-1) THEN
 520 :                 JJ=0
 521 :  297            CONTINUE
 522 :                 JJ=JJ+1
 523 :                 IF (JJ.LE.NBCONR) THEN
 524 :                   IF (ABS(ITEST2).NE.KON(JJ,NINT,1)) GOTO 297
 525 :                   ipoin1=IDCP(NI)
 526 :                   ipoin2=IDCP(ITEST2)
 527 :                   ipoin3=IDCP(ITEST1)
 527 :                   CALL ETEST2(ipoin1,ipoin2,ipoin3,NNOEUD)
 528 :                   IDCP(NI)=ipoin1
 529 :                   IDCP(ITEST2)=ipoin2
 530 :                   IDCP(ITEST1)=ipoin3
 531 :                   GOTO 253
 532 :                 ENDIF
 533 :                 GOTO 296
 534 :               ENDIF
 535 :             ENDIF
 536 : C
 537 : C           On finit de lire la ligne
 538 : C
 539 :             NINT=KON(NBCON,NINT,1)
 540 :             JJ=0
 541 :  298        CONTINUE
 542 :             JJ=JJ+1
 543 :             IF (JJ.LE.NKON) THEN
 544 :               IF (ABS(ITEST2).NE.KON(JJ,NINT,1)) GOTO 298
 545 :               ipoin1=IDCP(NI)
 546 :               ipoin2=IDCP(ITEST2)
 547 :               ipoin3=IDCP(ITEST1)
 547 :               CALL ETEST2(ipoin1,ipoin2,ipoin3,NNOEUD)
 548 :               IDCP(NI)=ipoin1
 549 :               IDCP(ITEST2)=ipoin2
 550 :               IDCP(ITEST1)=ipoin3
 551 :               GOTO 253
 552 :             ENDIF
 553 :  253      CONTINUE
 554 :           iadi=KON(NBCON,iadi,1)
 555 :  252    CONTINUE
 556 : C
 557 : C
 558 :   200   CONTINUE
 559 :         DO 254 J=1,jcompt
 560 :           ITEST1=KON(J,NCOMPT,1)
 561 :           ITEST2=KON(J,NCOMPT,2)
 562 :           IF (ITEST2.LT.0) GOTO 254
 563 :           JJ=jcompt
 564 :           IF (I.EQ.icompt) GOTO 398
 565 :  394      CONTINUE
 566 :           JJ=JJ+1
 567 :           IF (JJ.LE.NBCONR) THEN
 568 :             IF (ABS(ITEST2).NE.KON(JJ,NCOMPT,1)) GOTO 394
 569 :             ipoin1=IDCP(NI)
 570 :             ipoin2=IDCP(ITEST2)
 571 :             ipoin3=IDCP(ITEST1)
 571 :             CALL ETEST2(ipoin1,ipoin2,ipoin3,NNOEUD)
 572 :             IDCP(NI)=ipoin1
 573 :             IDCP(ITEST2)=ipoin2
 574 :             IDCP(ITEST1)=ipoin3
 575 :             GOTO 254
 576 :           ENDIF
 577 : C
 578 : C         Cas où il y a plus de deux lignes de connections pour un noeud
 579 : C
 580 :           NINT=NCOMPT
 581 :           IF (I.LT.icompt-1) THEN
 582 :             II=I
 583 :  396        CONTINUE
 584 :             II=II+1
 585 :             NINT=KON(NBCON,NINT,1)
 586 :             IF (II.LE.icompt-1) THEN
 587 :               JJ=0
 588 :  397          CONTINUE
 589 :               JJ=JJ+1
 590 :               IF (JJ.LE.NBCONR) THEN
 591 :                 IF (ABS(ITEST2).NE.KON(JJ,NINT,1)) GOTO 397
 592 :                 ipoin1=IDCP(NI)
 593 :                 ipoin2=IDCP(ITEST2)
 594 :                 ipoin3=IDCP(ITEST1)
 594 :                 CALL ETEST2(ipoin1,ipoin2,ipoin3,NNOEUD)
 595 :                 IDCP(NI)=ipoin1
 596 :                 IDCP(ITEST2)=ipoin2
 597 :                 IDCP(ITEST1)=ipoin3
 598 :                 GOTO 254
 599 :               ENDIF
 600 :               GOTO 396
 601 :             ENDIF
 602 :           ENDIF
 603 : C
 604 : C         On finit de lire la ligne
 605 : C
 606 :           NINT=KON(NBCON,NINT,1)
 607 :           JJ=0
 608 :  398      CONTINUE
 609 :           JJ=JJ+1
 610 :           IF (JJ.LE.NKON) THEN
 611 :           IF (ABS(ITEST2).NE.KON(JJ,NINT,1)) GOTO 398
 612 :           ipoin1=IDCP(NI)
 613 :           ipoin2=IDCP(ITEST2)
 614 :           ipoin3=IDCP(ITEST1)
 614 :           CALL ETEST2(ipoin1,ipoin2,ipoin3,NNOEUD)
 615 :           IDCP(NI)=ipoin1
 616 :           IDCP(ITEST2)=ipoin2
 617 :           IDCP(ITEST1)=ipoin3
 618 :           GOTO 254
 619 :         ENDIF
 620 :   254 CONTINUE
 621 : 
 622 :   50  CONTINUE
 623 : 
 624 :       SEGSUP KON,IDCP
 625 :       END
 626 : 
 627 : 
 628 : 
 629 : 
 630 : 
 631 : 
 632 : 
 633 : 
 634 : 
 635 :  
 636 :  
 637 :  
 638 :  
 639 :  
 640 :