Télécharger la plaquette Cast3M


fr en

Télécharger ligmai.eso

Retour à la liste

Numérotation des lignes : 

ligmai

  1. C LIGMAI    SOURCE    CB215821  26/08/24    21:17:09     12622          
  2.       SUBROUTINE LIGMAI(MELEME,TTRAV,ICAS)
  3. C_______________________________________________________________________
  4. C      ROUTINE LIGMAI
  5. C  ENTREE : MELEME ----> OBJET MAILLAGE
  6. C           ICAS         1 si on admet une boucle ferméé 0 sinon
  7. C  SORTIE : TTRAV -----> UN SEGMENT CONTENANT
  8. C                       - LA LIGNE DES NOEUDS
  9. C
  10. C ______________________________________________________________________
  11.       IMPLICIT INTEGER(I-N)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMCOORD
  17.       SEGMENT ICPR(nbpts)
  18.       SEGMENT IELE(MAXEL,NNOE)
  19.       SEGMENT TTRAV
  20.          INTEGER     ILIS(NNOE)
  21.       ENDSEGMENT
  22. *
  23. *   on separe les noeuds concernes en noeuds coins et noeuds
  24. *   milieux apres avoir verifie que les seuls elements presents
  25. *   sont des seg2 ou des seg3.
  26. *
  27.       SEGACT MELEME
  28.       IPT1=MELEME
  29.       DO 1  I=1,MAX(1,LISOUS(/1))
  30.       IF(LISOUS(/1).NE.0) THEN
  31.         IPT1=LISOUS(I)
  32.         SEGACT IPT1
  33.       ENDIF
  34.       IF(IPT1.ITYPEL.NE.2.AND.IPT1.ITYPEL.NE.3) THEN
  35. *         write( 6,FMT='('' pas bon itypel'')')
  36.          GO TO 1000
  37.       ENDIF
  38.    1  CONTINUE
  39.       SEGINI ICPR
  40.       NNOE=0
  41.       MAXEL=0
  42.       IELMAX=0
  43.       DO 2 IO=1,MAX(1,LISOUS(/1))
  44.       IF(LISOUS(/1).NE.0) THEN
  45.         IPT1=LISOUS(IO)
  46.       ENDIF
  47.       DO 1003 I=1,IPT1.NUM(/2)
  48.       DO 3 J=1,IPT1.NUM(/1)
  49.       IA=IPT1.NUM(J,I)
  50.       IF(ICPR(IA).EQ.0) THEN
  51.       NNOE=NNOE+1
  52.       ENDIF
  53.       ICPR(IA)=ICPR(IA)+1
  54.       MAXEL=MAX(MAXEL,ICPR(IA))
  55.     3 CONTINUE
  56.  1003 CONTINUE
  57.       IELMAX=MAX(IELMAX,IPT1.NUM(/2))
  58.     2 CONTINUE
  59.       IELMAX=IELMAX+1
  60. *      write(6,fmt='(''  nnoe   maxel  '',2i6)')nnoe,maxel
  61.       IF(NNOE.EQ.0) GO TO 1000
  62.       IF(MAXEL.GT.2) GO TO 1000
  63.       MAXEL=2
  64.       SEGINI IELE
  65.       IB=0
  66.       DO 4 I=1,ICPR(/1)
  67.       ICPR(I)=0
  68.    4  CONTINUE
  69.       DO 5 IO=1,MAX(1,LISOUS(/1))
  70.       IF(LISOUS(/1).NE.0) THEN
  71.         IPT1=LISOUS(IO)
  72.       ENDIF
  73.       DO 1004 I=1,IPT1.NUM(/2)
  74.       DO 6 J=1,IPT1.NUM(/1)
  75.       IA=IPT1.NUM(J,I)
  76.       IF(ICPR(IA).EQ.0) THEN
  77.       IB=IB+1
  78.       ICPR(IA)=IB
  79.       ENDIF
  80.       IBA=ICPR(IA)
  81.       IF(IELE(1,IBA).EQ.0) THEN
  82.         IELE(1,IBA)=I+IO*IELMAX
  83.       ELSE
  84.         IELE(2,IBA)=I+IO*IELMAX
  85.       ENDIF
  86.     6 CONTINUE
  87.  1004 CONTINUE
  88.     5 CONTINUE
  89. *
  90. *  pour trouver une extremite il faut un point extremeite d'un
  91. *  element qui n'appartient qu'a un seul element.
  92. *  A tout hasard on regarde si le premier element contient
  93. *  un point de depart.
  94. *
  95.       IF(LISOUS(/1).NE.0) IPT1=LISOUS(1)
  96.       IDEP=0
  97.       IA=IPT1.NUM(1,1)
  98.       IB=ICPR(IA)
  99.       IF(IELE(2,IB).EQ.0) THEN
  100.         IDEP=IA
  101.       ELSE
  102.          IA=IPT1.NUM(IPT1.NUM(/1),1)
  103.          IB=ICPR(IA)
  104.          IF(IELE(2,IB).EQ.0) THEN
  105.             IDEP=IA
  106.          ENDIF
  107.       ENDIF
  108.       IF(IDEP.EQ.0) THEN
  109. *  recherche d'un point de depart
  110.       DO 10 IO=1,MAX(1,LISOUS(/1))
  111.       IF(LISOUS(/1) .NE.0) IPT1=LISOUS(IO)
  112.       IDE=IPT1.NUM(/1)
  113.       DO 11 I=1,IPT1.NUM(/2)
  114.       IDEP=IPT1.NUM(1,I)
  115.       IB=ICPR(IDEP)
  116.       IF(IELE(2,IB).EQ.0) GO TO 12
  117.       IDEP=IPT1.NUM(IDE,I)
  118.       IB=ICPR(IDEP)
  119.       IF(IELE(2,IB).EQ.0) GO TO 12
  120.    11 CONTINUE
  121.    10 CONTINUE
  122.       IF( ICAS.EQ.1) THEN
  123. *  ON prend le premier point du premier element
  124.         IF(LISOUS(/1) .NE.0) IPT1=LISOUS(1)
  125.         IDEP=IPT1.NUM(1,1)
  126.         NNOE=NNOE+1
  127. *        write(6,fmt='('' nb de point à enregistrer '')') nnoe
  128.       ELSE
  129. *      write(6,fmt='('' pas de point de depart!'')')
  130. *      write(6,fmt='('' iele'',(3i6))')
  131. *     $(ko,iele(1,ko),iele(2,ko),ko=1,nnoe)
  132.          SEGSUP ICPR,IELE
  133.          GO TO 1000
  134.       ENDIF
  135.       ENDIF
  136.    12 CONTINUE
  137. *
  138. *  on connait le poiunt de depart IDEP il suffit de remplir
  139. *  le tableau  ilis de ttrav
  140. *
  141.       SEGINI TTRAV
  142.       ILIS(1)=IDEP
  143.       IA=ICPR(IDEP)
  144.       INLI=1
  145.        IDEINI=IDEP
  146. *         write(6,fmt='(''  inli,idep'',3i6)') inli,idep
  147.       IELPRE=IELE(1,IA)
  148.       IF(LISOUS(/1).NE.0) THEN
  149.         IO=IELPRE/IELMAX
  150.         IPT1=LISOUS(IO)
  151.         IEL=IELPRE-IO*IELMAX
  152.       ELSE
  153.         IEL=IELPRE-IELMAX
  154.       ENDIF
  155.       IF(IPT1.NUM(1,IEL).EQ.IDEP) THEN
  156.          DO 17 IK=2,IPT1.NUM(/1)
  157.          IDEP=IPT1.NUM(IK,IEL)
  158.          INLI=INLI+1
  159.          ILIS(INLI)=IDEP
  160. *         write(6,fmt='('' 17  inli,idep iel'',3i6)') inli,idep,iel
  161.    17    CONTINUE
  162.       ELSE
  163.          DO 18 IK=IPT1.NUM(/1)-1,1,-1
  164.          IDEP=IPT1.NUM(IK,IEL)
  165.          INLI=INLI+1
  166.          ILIS(INLI)=IDEP
  167. *         write(6,fmt='('' 18 inli,idep iel'',3i6)') inli,idep,iel
  168.    18    CONTINUE
  169.        ENDIF
  170.    20 CONTINUE
  171.       ILOC=ICPR(IDEP)
  172.       IA=IELE(1,ILOC)
  173. *       write(6,fmt='(''  idep,iloc,ia,ielpre'',4i6)')idep,iloc
  174. *     $,ia,ielpre
  175.       IF(IA.EQ.IELPRE) THEN
  176.         IA=IELE(2,ILOC)
  177. *       write(6,fmt='(''  idep,iloc,ia,ielpre'',4i6)')idep,iloc
  178. *     $,ia,ielpre
  179.         IF(IA.EQ.0) GO TO 30
  180.       ENDIF
  181.       IELPRE=IA
  182.       IF(LISOUS(/1).NE.0) THEN
  183.         IO=IA/IELMAX
  184.         IPT1=LISOUS(IO)
  185.         IA=IA-IO*IELMAX
  186.       ELSE
  187.         IA=IA-IELMAX
  188.       ENDIF
  189.       IF(IPT1.NUM(1,IA).EQ.IDEP) THEN
  190.          DO 21 IK=2,IPT1.NUM(/1)
  191.          IDEP=IPT1.NUM(IK,IA)
  192.          INLI=INLI+1
  193.          ILIS(INLI)=IDEP
  194. *         write(6,fmt='('' 21 inli,idep iel'',3i6)') inli,idep,iel
  195.    21    CONTINUE
  196.       ELSE
  197.          DO 22 IK=IPT1.NUM(/1)-1,1,-1
  198.          IDEP=IPT1.NUM(IK,IA)
  199.          INLI=INLI+1
  200.          ILIS(INLI)=IDEP
  201. *         write(6,fmt='('' 22 inli,idep iel'',3i6)') inli,idep,iel
  202.    22    CONTINUE
  203.       ENDIF
  204.       IF(IDEP.NE.IDEINI)GO TO 20
  205.    30 CONTINUE
  206.       SEGSUP ICPR,IELE
  207.         IF(INLI.NE.NNOE) THEN
  208. *      write(6,fmt='('' icas0 inli nnoe '',2i6)') inli,nnoe
  209.           SEGSUP TTRAV
  210.           GO TO 1000
  211.         ENDIF
  212.       GO TO 1002
  213. 1000  CALL ERREUR(426)
  214. 1002  CONTINUE
  215.       END
  216.  
  217.  
  218.  
  219.  
  220.  

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