Télécharger manuel.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUEL SOURCE BP208322 16/11/18 21:19:03 9177
  2. SUBROUTINE MANUEL
  3. C
  4. C FABRICATION MANUELLE D OBJETS DIVERS ET VARIES
  5. C DE TYPE ELEMENT,CHAMPOIN,SOLUTION, RIGIDITE, CHAMELEM ,EVOLUTION
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. -INC CCOPTIO
  9. -INC CCGEOME
  10. -INC SMELEME
  11. SEGMENT MTRT
  12. INTEGER MTT(NTT)
  13. ENDSEGMENT
  14. PARAMETER (LMOOPT=7)
  15. CHARACTER*4 MOOPT(LMOOPT)
  16. DATA MOOPT/'CHPO','MODE','RIGI','CHEL','CHAM','CHML','OBJE'/
  17. CALL LIRMOT(NOMS,NOMBR,I,0)
  18. IF (I.NE.0) GOTO 2
  19. CALL LIRMOT(MOOPT,LMOOPT,IMOT,1)
  20. IF(IERR.NE.0) RETURN
  21. GO TO (100,200,300,400,500,600,700),IMOT
  22. 100 CALL MANUCH
  23. GO TO 30
  24. 200 CALL MANUMO
  25. GO TO 30
  26. 300 CALL MANURI
  27. GO TO 30
  28. 400 CALL MANUCE
  29. GO TO 30
  30. 500 CALL MAMANU
  31. GO TO 30
  32. 600 CALL MANUC5
  33. GO TO 30
  34. 700 CALL MANUOB
  35. GO TO 30
  36. c
  37. c==== Cas des Objets MAILLAGES ====================================
  38. 2 ITYP=I
  39. CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
  40. IF (ICOUL.EQ.0) ICOUL=IDCOUL+1
  41. ICOUL=ICOUL-1
  42. NBSOUS=0
  43. NBREF=0
  44. NBELEM=1
  45. c---- SUPERELEMENT ---------------
  46. IF(NOMS(ITYP).EQ.'SUPE') THEN
  47. CALL LIROBJ('MAILLAGE',IPT1,0,IRETOU)
  48. IF(IRETOU.EQ.0) GO TO 25
  49. SEGACT IPT1
  50. IF(IPT1.ITYPEL.NE.1) THEN
  51. CALL CHANGE ( IPT1,1)
  52. IF (IERR.NE.0) RETURN
  53. SEGACT IPT1
  54. ENDIF
  55. NBNN = IPT1.NUM(/2)
  56. SEGINI MELEME
  57. ICOLOR(1)=ICOUL
  58. ITYPEL=ITYP
  59. DO 26 I=1,NBNN
  60. NUM(I,1)=IPT1.NUM(1,I)
  61. 26 CONTINUE
  62. GO TO 11
  63. 25 NTT=50
  64. SEGINI MTRT
  65. NBNN=0
  66. 28 CONTINUE
  67. CALL LIROBJ('POINT ',IP,0,IRETOU)
  68. IF(IRETOU.EQ.0)GO TO 29
  69. NBNN=NBNN + 1
  70. IF(NBNN.GT.NTT) THEN
  71. NTT=NTT+50
  72. SEGADJ MTRT
  73. ENDIF
  74. MTT(NBNN) = IP
  75. GO TO 28
  76. 29 CONTINUE
  77. SEGINI MELEME
  78. ICOLOR(1)=ICOUL
  79. ITYPEL=ITYP
  80. DO 27 I=1,NBNN
  81. NUM(I,1)=MTT(I)
  82. 27 CONTINUE
  83. SEGSUP MTRT
  84. c---- AUTRE TYPE D'ELEMENTS ---------------
  85. ELSE
  86. NBNN=NBNNE(ITYP)
  87. c dans le cas POLYgone et MULtiplicateur le nbre de noeuds par
  88. c element est indefini d'ou la lecture facultative des points
  89. IF (NOMS(ITYP).EQ.'POLY') THEN
  90. NBNN = 14
  91. IDOBL = 0
  92. ELSE IF (NOMS(ITYP).EQ.'MULT') THEN
  93. NBNN = 9999
  94. IDOBL = 0
  95. ELSE
  96. IDOBL = 1
  97. ENDIF
  98. SEGINI MELEME
  99. ICOLOR(1)=ICOUL
  100. ITYPEL=ITYP
  101. C SG On ajoute la possibilité de générer un élément à partir
  102. C des premiers points d'un maillage de 'POI1'
  103. CALL LIROBJ('MAILLAGE',IPT1,0,IRETOU)
  104. IF (IRETOU.NE.0) THEN
  105. SEGACT IPT1
  106. IF(IPT1.ITYPEL.NE.1) THEN
  107. CALL CHANGE ( IPT1,1)
  108. IF (IERR.NE.0) RETURN
  109. SEGACT IPT1
  110. ENDIF
  111. NBNN1=IPT1.NUM(/2)
  112. IF (NBNN1.EQ.0) THEN
  113. NBELEM=0
  114. SEGADJ MELEME
  115. GOTO 11
  116. ENDIF
  117. IF (IDOBL.EQ.0) NBNN=NBNN1
  118. SEGINI MELEME
  119. ICOLOR(1)=ICOUL
  120. ITYPEL=ITYP
  121. DO 260 I=1,NBNN
  122. NUM(I,1)=IPT1.NUM(1,(MOD(I-1,NBNN1))+1)
  123. 260 CONTINUE
  124. ELSE
  125. DO 10 I=1,NBNN
  126. c CALL LIROBJ('POINT ',IP,IDOBL,IRETOU)
  127. c on donne ici la possibilité de créer un meleme avec 0 élément
  128. IF(I.EQ.1) THEN
  129. CALL LIROBJ('POINT ',IP,0,IRETOU)
  130. ELSE
  131. CALL LIROBJ('POINT ',IP,IDOBL,IRETOU)
  132. ENDIF
  133. IF (IRETOU.NE.1) THEN
  134. IF (I.EQ.1) THEN
  135. NBELEM = 0
  136. SEGADJ MELEME
  137. if(iimpi.ge.1) write(ioimp,*
  138. $ )'MAILLAGE DE 0 ELEMENT CREE'
  139. ENDIF
  140. IF (IDOBL.EQ.0) THEN
  141. C CAS DU POLYGONE ou du MULT
  142. NBNN = I-1
  143. SEGADJ MELEME
  144. ENDIF
  145. GOTO 11
  146. ENDIF
  147. NUM(I,1)=IP
  148. 10 CONTINUE
  149. ENDIF
  150. ENDIF
  151. 11 CONTINUE
  152. IF (IERR.NE.0) GOTO 20
  153. CALL ECROBJ('MAILLAGE',MELEME)
  154. SEGDES MELEME
  155. RETURN
  156. 20 SEGSUP MELEME
  157. 30 CONTINUE
  158. RETURN
  159. END
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  

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