Télécharger ligmai.eso

Retour à la liste

Numérotation des lignes :

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

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