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    PV        20/03/30    21:20:41     10567          
  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 3 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.       IELMAX=MAX(IELMAX,IPT1.NUM(/2))
  57.     2 CONTINUE
  58.       IELMAX=IELMAX+1
  59. *      write(6,fmt='(''  nnoe   maxel  '',2i6)')nnoe,maxel
  60.       IF(NNOE.EQ.0) GO TO 1000
  61.       IF(MAXEL.GT.2) GO TO 1000
  62.       MAXEL=2
  63.       SEGINI IELE
  64.       IB=0
  65.       DO 4 I=1,ICPR(/1)
  66.       ICPR(I)=0
  67.    4  CONTINUE
  68.       DO 5 IO=1,MAX(1,LISOUS(/1))
  69.       IF(LISOUS(/1).NE.0) THEN
  70.         IPT1=LISOUS(IO)
  71.       ENDIF
  72.       DO 6 I=1,IPT1.NUM(/2)
  73.       DO 6 J=1,IPT1.NUM(/1)
  74.       IA=IPT1.NUM(J,I)
  75.       IF(ICPR(IA).EQ.0) THEN
  76.       IB=IB+1
  77.       ICPR(IA)=IB
  78.       ENDIF
  79.       IBA=ICPR(IA)
  80.       IF(IELE(1,IBA).EQ.0) THEN
  81.         IELE(1,IBA)=I+IO*IELMAX
  82.       ELSE
  83.         IELE(2,IBA)=I+IO*IELMAX
  84.       ENDIF
  85.     6 CONTINUE
  86.     5 CONTINUE
  87. *
  88. *  pour trouver une extremite il faut un point extremeite d'un
  89. *  element qui n'appartient qu'a un seul element.
  90. *  A tout hasard on regarde si le premier element contient
  91. *  un point de depart.
  92. *
  93.       IF(LISOUS(/1).NE.0) IPT1=LISOUS(1)
  94.       IDEP=0
  95.       IA=IPT1.NUM(1,1)
  96.       IB=ICPR(IA)
  97.       IF(IELE(2,IB).EQ.0) THEN
  98.         IDEP=IA
  99.       ELSE
  100.          IA=IPT1.NUM(IPT1.NUM(/1),1)
  101.          IB=ICPR(IA)
  102.          IF(IELE(2,IB).EQ.0) THEN
  103.             IDEP=IA
  104.          ENDIF
  105.       ENDIF
  106.       IF(IDEP.EQ.0) THEN
  107. *  recherche d'un point de depart
  108.       DO 10 IO=1,MAX(1,LISOUS(/1))
  109.       IF(LISOUS(/1) .NE.0) IPT1=LISOUS(IO)
  110.       IDE=IPT1.NUM(/1)
  111.       DO 11 I=1,IPT1.NUM(/2)
  112.       IDEP=IPT1.NUM(1,I)
  113.       IB=ICPR(IDEP)
  114.       IF(IELE(2,IB).EQ.0) GO TO 12
  115.       IDEP=IPT1.NUM(IDE,I)
  116.       IB=ICPR(IDEP)
  117.       IF(IELE(2,IB).EQ.0) GO TO 12
  118.    11 CONTINUE
  119.    10 CONTINUE
  120.       IF( ICAS.EQ.1) THEN
  121. *  ON prend le premier point du premier element
  122.         IF(LISOUS(/1) .NE.0) IPT1=LISOUS(1)
  123.         IDEP=IPT1.NUM(1,1)
  124.         NNOE=NNOE+1
  125. *        write(6,fmt='('' nb de point à enregistrer '')') nnoe
  126.       ELSE
  127. *      write(6,fmt='('' pas de point de depart!'')')
  128. *      write(6,fmt='('' iele'',(3i6))')
  129. *     $(ko,iele(1,ko),iele(2,ko),ko=1,nnoe)
  130.          SEGSUP ICPR,IELE
  131.          GO TO 1000
  132.       ENDIF
  133.       ENDIF
  134.    12 CONTINUE
  135. *
  136. *  on connait le poiunt de depart IDEP il suffit de remplir
  137. *  le tableau  ilis de ttrav
  138. *
  139.       SEGINI TTRAV
  140.       ILIS(1)=IDEP
  141.       IA=ICPR(IDEP)
  142.       INLI=1
  143.        IDEINI=IDEP
  144. *         write(6,fmt='(''  inli,idep'',3i6)') inli,idep
  145.       IELPRE=IELE(1,IA)
  146.       IF(LISOUS(/1).NE.0) THEN
  147.         IO=IELPRE/IELMAX
  148.         IPT1=LISOUS(IO)
  149.         IEL=IELPRE-IO*IELMAX
  150.       ELSE
  151.         IEL=IELPRE-IELMAX
  152.       ENDIF
  153.       IF(IPT1.NUM(1,IEL).EQ.IDEP) THEN
  154.          DO 17 IK=2,IPT1.NUM(/1)
  155.          IDEP=IPT1.NUM(IK,IEL)
  156.          INLI=INLI+1
  157.          ILIS(INLI)=IDEP
  158. *         write(6,fmt='('' 17  inli,idep iel'',3i6)') inli,idep,iel
  159.    17    CONTINUE
  160.       ELSE
  161.          DO 18 IK=IPT1.NUM(/1)-1,1,-1
  162.          IDEP=IPT1.NUM(IK,IEL)
  163.          INLI=INLI+1
  164.          ILIS(INLI)=IDEP
  165. *         write(6,fmt='('' 18 inli,idep iel'',3i6)') inli,idep,iel
  166.    18    CONTINUE
  167.        ENDIF
  168.    20 CONTINUE
  169.       ILOC=ICPR(IDEP)
  170.       IA=IELE(1,ILOC)
  171. *       write(6,fmt='(''  idep,iloc,ia,ielpre'',4i6)')idep,iloc
  172. *     $,ia,ielpre
  173.       IF(IA.EQ.IELPRE) THEN
  174.         IA=IELE(2,ILOC)
  175. *       write(6,fmt='(''  idep,iloc,ia,ielpre'',4i6)')idep,iloc
  176. *     $,ia,ielpre
  177.         IF(IA.EQ.0) GO TO 30
  178.       ENDIF
  179.       IELPRE=IA
  180.       IF(LISOUS(/1).NE.0) THEN
  181.         IO=IA/IELMAX
  182.         IPT1=LISOUS(IO)
  183.         IA=IA-IO*IELMAX
  184.       ELSE
  185.         IA=IA-IELMAX
  186.       ENDIF
  187.       IF(IPT1.NUM(1,IA).EQ.IDEP) THEN
  188.          DO 21 IK=2,IPT1.NUM(/1)
  189.          IDEP=IPT1.NUM(IK,IA)
  190.          INLI=INLI+1
  191.          ILIS(INLI)=IDEP
  192. *         write(6,fmt='('' 21 inli,idep iel'',3i6)') inli,idep,iel
  193.    21    CONTINUE
  194.       ELSE
  195.          DO 22 IK=IPT1.NUM(/1)-1,1,-1
  196.          IDEP=IPT1.NUM(IK,IA)
  197.          INLI=INLI+1
  198.          ILIS(INLI)=IDEP
  199. *         write(6,fmt='('' 22 inli,idep iel'',3i6)') inli,idep,iel
  200.    22    CONTINUE
  201.       ENDIF
  202.       IF(IDEP.NE.IDEINI)GO TO 20
  203.    30 CONTINUE
  204.       SEGSUP ICPR,IELE
  205.         IF(INLI.NE.NNOE) THEN
  206. *      write(6,fmt='('' icas0 inli nnoe '',2i6)') inli,nnoe
  207.           SEGSUP TTRAV
  208.           GO TO 1000
  209.         ENDIF
  210.       GO TO 1002
  211. 1000  CALL ERREUR(426)
  212. 1002  CONTINUE
  213.       END
  214.  
  215.  
  216.  
  217.  

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