Télécharger la plaquette Cast3M


fr en

Télécharger vtop2d.eso

Retour à la liste

Numérotation des lignes : 

vtop2d

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

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