Télécharger elstru.eso

Retour à la liste

Numérotation des lignes :

  1. C ELSTRU SOURCE FANDEUR 10/12/14 21:16:02 6812
  2. SUBROUTINE ELSTRU
  3. C
  4. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN MELEME (SOUS GEOM
  6. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. -INC CCOPTIO
  11. -INC SMELSTR
  12. -INC SMSTRUC
  13. -INC SMELEME
  14. -INC SMRIGID
  15. -INC SMCHAML
  16. SEGMENT ITRAV(0)
  17. SEGMENT ITRA1(0)
  18. C
  19. C LECTURE DU POINT OU ...
  20. C
  21. CALL LIROBJ('POINT ',IRET,0,IRETOU)
  22. IF(IRETOU.EQ.1) THEN
  23. NBNN=1
  24. NBELEM=1
  25. NBSOUS=0
  26. NBREF=0
  27. SEGINI MELEME
  28. ITYPEL=1
  29. NUM(1,1)=IRET
  30. C
  31. C ... LECTURE DU MELEME
  32. C
  33. ELSE
  34. CALL LIROBJ('MAILLAGE',IRET,1,IRETOU)
  35. C *** PAS D'OBJET DE TYPE ELEMENT OU POINT
  36. IF(IERR.NE.0) THEN
  37. MOTERR(1:8)='MAILLAGE'
  38. CALL ERREUR(37)
  39. MOTERR(9:16)='POINT'
  40. CALL ERREUR(37)
  41. RETURN
  42. ENDIF
  43. MELEME=IRET
  44. SEGACT MELEME
  45. IF (ITYPEL.NE.1) THEN
  46. SEGDES MELEME
  47. C *** LE MELEME N'EST PAS ELEMENTAIRE
  48. INTERR(1)=MELEME
  49. CALL ERREUR(89)
  50. RETURN
  51. ENDIF
  52. ENDIF
  53. C
  54. C LECTURE DE LA SOUS-STRUCTURE
  55. C
  56. CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU)
  57. IF(IERR.NE.0) THEN
  58. MOTERR(1:8)='STRUCTUR'
  59. C *** PAS D'OBJET DE TYPE STRUCTURE
  60. CALL ERREUR(37)
  61. RETURN
  62. ENDIF
  63. C
  64. NBPT=NUM(/2)
  65. SEGINI ITRAV
  66. DO 20 L=1,NBPT
  67. ITRAV(**)=NUM(1,L)
  68. 20 CONTINUE
  69. SEGDES MELEME
  70. IMEL=MELEME
  71. C
  72. MSTRUC=KOBJET
  73. SEGACT MSTRUC
  74. NSTRU=LISTRU(/1)
  75. IF(NSTRU.EQ.1) GOTO 30
  76. C
  77. C LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE
  78. C
  79. CALL LIRENT(NSTRU,1,IRETOU)
  80. IF(IERR.EQ.0) GOTO 30
  81. SEGDES MSTRUC
  82. SEGSUP ITRAV
  83. C *** LE MELEM DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE
  84. INTERR(1)=MSTRUC
  85. CALL ERREUR(90)
  86. RETURN
  87. 30 MSOSTU=LISTRU(NSTRU)
  88. C
  89. C LE MELEME DOIT ETRE INCLUS DANS LA SOUS-STRUCTURE
  90. C
  91. SEGINI ITRA1
  92. SEGACT MSOSTU
  93. IF(ISRAID.EQ.0) THEN
  94. MCHELM=ISCHAM(1)
  95. SEGDES MSOSTU
  96. SEGACT MCHELM
  97. NSOUS=IMACHE(/1)
  98. C
  99. C ******** BOUCLE SUR LES ZONES GEO.ELEM. DU CHAMP DE MATERIAU
  100. C
  101. DO 49 IAB=1,NSOUS
  102. MELEME=IMACHE(IAB)
  103. SEGACT MELEME
  104. IF(ITYPEL.EQ.22) GO TO 47
  105. NBELEM=NUM(/2)
  106. NBP=NUM(/1)
  107. DO 41 NBE=1,NBELEM
  108. DO 41 NP=1,NBP
  109. ITRA1(**)=NUM(NP,NBE)
  110. 41 CONTINUE
  111. 47 SEGDES MELEME
  112. 49 CONTINUE
  113. SEGDES,MCHELM
  114. ELSE
  115. MRIGID=ISRAID
  116. SEGACT MRIGID
  117. NRIGEL=IRIGEL(/2)
  118. C
  119. C BOUCLE SUR LES ZONES GEOMETRIQUES DE LA SOUS STRUCTURE
  120. C
  121. DO 55 IAA=1,NRIGEL
  122. MELEME=IRIGEL(1,IAA)
  123. SEGACT MELEME
  124. IF(ITYPEL.EQ.22) GOTO 50
  125. NBELEM=NUM(/2)
  126. NBP=NUM(/1)
  127. DO 40 NBE=1,NBELEM
  128. DO 40 NP=1,NBP
  129. ITRA1(**)=NUM(NP,NBE)
  130. 40 CONTINUE
  131. 50 SEGDES MELEME
  132. 55 CONTINUE
  133. SEGDES MRIGID
  134. ENDIF
  135. NL=ITRA1(/1)
  136. DO 65 I=1,NBPT
  137. IKI=ITRAV(I)
  138. DO 60 J=1,NL
  139. IF(ITRA1(J).EQ.IKI) GOTO 65
  140. 60 CONTINUE
  141. C *** UN PT DU MELEME N'APPARTIENT PAS A LA SS STRUCTURE
  142. INTERR(1)=IKI
  143. INTERR(2)=MSTRUC
  144. CALL ERREUR(91)
  145. GOTO 100
  146. 65 CONTINUE
  147. SEGSUP ITRAV
  148. SEGSUP ITRA1
  149. N=1
  150. SEGINI MELSTR
  151. IMELEM(1)=IMEL
  152. ISOSTU(1)=MSOSTU
  153. SEGDES MSOSTU
  154. SEGDES MSTRUC
  155. C
  156. C ECRITURE DU MELSTR
  157. C
  158. CALL ECROBJ('ELEMSTRU',MELSTR)
  159. SEGDES MELSTR
  160. RETURN
  161. 100 CONTINUE
  162. SEGSUP ITRAV
  163. SEGSUP ITRA1
  164. RETURN
  165. END
  166.  
  167.  
  168.  
  169.  

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