Télécharger manuc5.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUC5 SOURCE CB215821 19/08/20 21:19:26 10287
  2.  
  3. *--------------------------------------------------------------------*
  4. * *
  5. * CREATION D'UN NOUVEAU CHAMELEM PAR MANU *
  6. * *
  7. *--------------------------------------------------------------------*
  8. SUBROUTINE MANUC5
  9.  
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. -INC CCOPTIO
  13.  
  14. -INC SMLMOTS
  15. -INC SMLREEL
  16. -INC SMLENTI
  17. -INC SMELEME
  18. -INC SMMODEL
  19. *
  20. CHARACTER*4 MOCHOI,MOTYPE(3)
  21. CHARACTER*8 MOCHOY
  22. CHARACTER*8 CAR
  23. CHARACTER*16 JECONS
  24. CHARACTER*72 JEROME
  25. CHARACTER*8 LISMOT(5),REPA(1)
  26. DATA MOTYPE/'TYPE','CONS','EVOL'/
  27. DATA REPA/'REPA'/
  28. DATA LISMOT/'NOEUD','GRAVITE','RIGIDITE','MASSE','STRESSES'/
  29. *
  30. * Initialisation des segments
  31. *
  32. IPMODL=0
  33. IPMAIL=0
  34. IPLAC =0
  35. *
  36. * LECTURE D'UN MODELE
  37. *
  38. CALL LIROBJ('MMODEL ',IPMODL,0,IRET)
  39. IF (IRET .EQ. 1) CALL ACTOBJ('MMODEL ',IPMODL,1)
  40. IF (IERR.NE.0) RETURN
  41. IF (IRET.EQ.0) THEN
  42. *
  43. * SINON D'UN MAILLAGE
  44. *
  45. MOTERR(1:8)='MAILLAGE'
  46. CALL MESLIR(-137)
  47. CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET)
  48. IF (IERR.NE.0) RETURN
  49. *
  50. * SINON lecture du mot EVOL
  51. *
  52. IF (IRET.EQ.1) THEN
  53. CALL ACTOBJ('MAILLAGE',IPMAIL,1)
  54. ELSE
  55. CALL LIRMOT(MOTYPE(3),1,IPLAC,0)
  56. IF (IERR.NE.0) RETURN
  57. IF (IPLAC.NE.1) THEN
  58. CALL ERREUR(907)
  59. RETURN
  60. ENDIF
  61. IF (IPLAC.EQ.1) THEN
  62. CALL MANUC8
  63. RETURN
  64. ENDIF
  65. ENDIF
  66. ENDIF
  67. *
  68. JG=0
  69. JGN=4
  70. JGM=0
  71. CALL oooprl(1)
  72. SEGINI,MLMOTS,MLMOT1,MLMOT2,MLMOT3,MLREE1,MLENT2
  73. CALL oooprl(0)
  74.  
  75. L1 = 0
  76. LL1 = 0
  77. IPLAC = 0
  78. *
  79. itart=0
  80. CALL LIRMOT(REPA,1,itart,0)
  81. IF (IERR.NE.0) GOTO 99
  82. *
  83. 10 CONTINUE
  84. *
  85. * ON DESIRE LIRE UNE COMPOSANTE
  86. *
  87. IRCHOI = 0
  88. CALL LIRCHA(MOCHOY,0,IRCHOI)
  89. IF (IERR.NE.0) GOTO 99
  90. IF (IRCHOI.EQ.0) GO TO 20
  91. MOCHOI=MOCHOY(1:4)
  92. *
  93. * SI ON A LU LE MOT TYPE
  94. *
  95. IF (MOCHOI.EQ.MOTYPE(1)) THEN
  96. CALL LIRCHA(JEROME,1,L1)
  97. GOTO 10
  98. ENDIF
  99. *
  100. * SI ON A LU LE MOT CONS
  101. *
  102. IF(IPMAIL.NE.0)THEN
  103. IF(MOCHOI.EQ.MOTYPE(2)) THEN
  104. CALL LIRCHA(JECONS,1,LL1)
  105. GO TO 10
  106. ENDIF
  107. ENDIF
  108. IF(IPMODL.NE.0.AND.IPLAC.EQ.0)THEN
  109. CALL PLACE(LISMOT,5,IPLAC,MOCHOY)
  110. IF (IPLAC.NE.0)GOTO 10
  111. ENDIF
  112. *
  113. * SINON ON TESTE LE NOMBRE DE CARACTERES LUS
  114. *
  115. IF(IRCHOI.GT.4) THEN
  116. CALL ERREUR(536)
  117. GOTO 99
  118. ENDIF
  119. *
  120. CALL LIRREE(RECOM,0,IRET2)
  121. IF (IRET2.EQ.1) THEN
  122. MLMOT1.MOTS(**) = MOCHOI
  123. JG=MLREE1.PROG(/1)+1
  124. SEGADJ MLREE1
  125. MLREE1.PROG(JG)=RECOM
  126. ELSE
  127. CALL QUETYP(CAR,0,IRET1)
  128. IF (IERR.NE.0) GO TO 99
  129. CALL LIROBJ(CAR,IPTRUC,0,IRET1)
  130. IF(IRET1 .EQ. 1) CALL ACTOBJ(CAR,IPTRUC,1)
  131. IF (IERR.NE.0) GO TO 99
  132. *
  133. * ON A LU UN OBJET DE TYPE AUTRE QU'UN FLOTTANT
  134. *
  135. MLMOT2.MOTS(**) = MOCHOI
  136. MLMOT3.MOTS(**)=CAR(1:4)
  137. MOTS(**) =CAR(5:8)
  138. JG=MLENT2.LECT(/1)+1
  139. SEGADJ MLENT2
  140. MLENT2.LECT(JG)=IPTRUC
  141. ENDIF
  142. GOTO 10
  143. *
  144. 20 CONTINUE
  145.  
  146. IPOI1 = 0
  147. IF ( L1.EQ.0) THEN
  148. JEROME=' '
  149. L1 = 1
  150. ENDIF
  151. *
  152. * RECUPERATION DES ZONES ELEMENTAIRES DU MAILLAGE
  153. *
  154. IF(IPMAIL.NE.0)THEN
  155. MELEME=IPMAIL
  156. JG=LISOUS(/1)
  157. IF (JG.EQ.0) THEN
  158. JG=1
  159. JGN=16
  160. JGM=JG
  161. CALL oooprl(1)
  162. SEGINI MLENT1,MLMOT4
  163. CALL oooprl(0)
  164. MLENT1.LECT(1)=IPMAIL
  165. ELSE
  166. JGN=16
  167. JGM=JG
  168. CALL oooprl(1)
  169. SEGINI MLENT1,MLMOT4
  170. CALL oooprl(0)
  171. DO 22 I =1,JG
  172. MLENT1.LECT(I)=LISOUS(I)
  173. 22 CONTINUE
  174. ENDIF
  175. *
  176. IF ( LL1.EQ.0) THEN
  177. JECONS=' '
  178. ENDIF
  179. *
  180. * ON STOCKE LE NOM DU COMPOSANT
  181. DO 23 I=1,JG
  182. MLMOT4.MOTS(I)=JECONS
  183. 23 CONTINUE
  184. *
  185. CALL MANUC4(MLENT1,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,
  186. & MLENT2,JEROME,L1,MLMOT4,IPOI1)
  187. *
  188. * Suppression des segments
  189. *
  190. SEGSUP,MLENT1
  191. SEGSUP,MLMOT4
  192.  
  193. ELSE
  194. IF(IPLAC.EQ.0)IPLAC=1
  195. MMODEL=IPMODL
  196. N1 = KMODEL(/1)
  197. CALL MANUC6(IPMODL,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,
  198. & MLENT2,JEROME,L1,IPLAC,IPOI1,itart)
  199. ENDIF
  200.  
  201. IF (IERR.NE.0) GOTO 99
  202.  
  203. * Ecriture du CHAMP resultat :
  204. CALL ACTOBJ('MCHAML ',IPOI1,1)
  205. CALL ECROBJ('MCHAML ',IPOI1)
  206. *
  207. * Suppression des segments
  208. *
  209. 99 CONTINUE
  210. SEGSUP,MLMOTS,MLMOT1,MLMOT2,MLMOT3,MLREE1,MLENT2
  211.  
  212. END
  213.  
  214.  
  215.  

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