Télécharger mamanu.eso

Retour à la liste

Numérotation des lignes :

  1. C MAMANU SOURCE CHAT 11/03/16 21:27:08 6902
  2. SUBROUTINE MAMANU
  3. *--------------------------------------------------------------------*
  4. * *
  5. * CREATION D'UN NOUVEAU CHAMELEM PAR MANU *
  6. * (OPTION 'CHAM' PP 24/11/92) *
  7. * *
  8. *--------------------------------------------------------------------*
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11. -INC CCOPTIO
  12. -INC SMELEME
  13. -INC SMMODEL
  14. -INC SMCHAML
  15. *
  16. SEGMENT INFO
  17. INTEGER INFELL(JG)
  18. ENDSEGMENT
  19. *
  20. CHARACTER*4 MOCHOI,MOTYPE(2)
  21. CHARACTER*8 MOCHOY
  22. CHARACTER*8 TYPOBJ
  23. CHARACTER*72 CHATYPE
  24. CHARACTER*8 LISMOT(5)
  25. DATA MOTYPE/'TYPE','POSI'/
  26. DATA LISMOT/'NOEUD','GRAVITE','RIGIDITE','MASSE','STRESSES'/
  27. *
  28. * LECTURE (IMPERATIVE) D'UN MODELE
  29. *
  30. CALL LIROBJ('MMODEL',MMODEL,1,IRET)
  31. IF (IERR.NE.0) RETURN
  32. *
  33. * OPTION PAR DEFAUT
  34. *
  35. LTYPE=1
  36. CHATYPE=' '
  37. IPOSI=1
  38. *
  39. * ON DESIRE LIRE SOIT UN MOT CLE, SOIT UN NOM DE COMPOSANTE
  40. *
  41. 1 IRCHOI = 0
  42. CALL LIRCHA(MOCHOY,1,IRCHOI)
  43. IF (IERR.NE.0) RETURN
  44. MOCHOI=MOCHOY(1:4)
  45. *
  46. * TRAITEMENT DES MOTS CLE
  47. *
  48. CALL PLACE(MOTYPE,2,IPLACE,MOCHOI)
  49. IF(IPLACE.EQ.0) GOTO 30
  50. GOTO(10,20),IPLACE
  51. *
  52. * SOUS-TYPE
  53. *
  54. 10 CONTINUE
  55. CALL LIRCHA(CHATYPE,1,LTYPE)
  56. IF (IERR.NE.0) RETURN
  57. GOTO 1
  58. *
  59. * PLACE
  60. *
  61. 20 CONTINUE
  62. CALL LIRMOT(LISMOT,5,IPOSI,1)
  63. IF (IERR.NE.0) RETURN
  64. GOTO 1
  65. *
  66. * MOCHOI EST LA COMPOSANTE, ON LIT MAINTENANT LES ENTIERS
  67. *
  68. 30 CONTINUE
  69. CALL LIRENT(IENT1,1,IRET)
  70. IF (IERR.NE.0) RETURN
  71. CALL LIRENT(IENT2,1,IRET)
  72. IF (IERR.NE.0) RETURN
  73. CALL LIRENT(IENT3,0,IRET)
  74. IF(IRET.EQ.0)THEN
  75. IENT3=1
  76. ENDIF
  77. *
  78. * LECTURE DE L'OBJET QUELCONQUE
  79. * MODIF AM 30/1/95 ON AUTORISE SEULEMENT LES REELS
  80. *
  81. * CALL LIRREE(XFLOT,0,IRETF)
  82. *
  83. CALL LIRREE(XFLOT,1,IRETF)
  84. IF(IERR.NE.0) RETURN
  85. *
  86. IF (IRETF.EQ.0) THEN
  87. CALL QUETYP(TYPOBJ,1,IRET)
  88. IF (IERR.NE.0) RETURN
  89. CALL LIROBJ(TYPOBJ,IPOBJ,1,IRET)
  90. IF (IERR.NE.0) RETURN
  91. ENDIF
  92. *
  93. * ON VERIFIE IENT1,IENT2 ET IENT3
  94. *
  95. SEGACT,MMODEL
  96. NZONE=KMODEL(/1)
  97. IF(IENT3.GT.NZONE)THEN
  98. INTERR(1)=IENT3
  99. INTERR(2)=NZONE
  100. CALL ERREUR(8001)
  101. SEGDES,MMODEL
  102. RETURN
  103. ENDIF
  104. *
  105. IMODEL=KMODEL(IENT3)
  106. SEGDES,MMODEL
  107. SEGACT,IMODEL
  108. MELEME=IMAMOD
  109. SEGACT,MELEME
  110. NBELEM=NUM(/2)
  111. IF(IENT1.GT.NBELEM)THEN
  112. INTERR(1)=IENT1
  113. INTERR(2)=NBELEM
  114. INTERR(3)=IENT3
  115. CALL ERREUR(8002)
  116. SEGDES,MELEME,IMODEL
  117. RETURN
  118. ENDIF
  119. *
  120. MELE=NEFMOD
  121. NFOR=FORMOD(/2)
  122. CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE ')
  123. IF(IMECA.EQ.0)THEN
  124. INTERR(1)=IENT3
  125. CALL ERREUR(8003)
  126. RETURN
  127. ENDIF
  128. MINTE=0
  129. IF(IPOSI.EQ.1)THEN
  130. NBPGAU=NUM(/1)
  131. ELSE
  132. if(infmod(/1).lt. 2+iposi) then
  133. CALL ELQUOI(MELE,0,IPOSI,INFO,IMODEL)
  134. MINTE=INFELL(11)
  135. IF(IPOSI.EQ.2)NBPGAU=1
  136. IF(IPOSI.EQ.3)NBPGAU=INFELL(6)
  137. IF(IPOSI.EQ.4)NBPGAU=INFELL(3)
  138. IF(IPOSI.EQ.5)NBPGAU=INFELL(4)
  139. SEGSUP,INFO
  140. else
  141. minte=infmod(iposi+2)
  142. IF(IPOSI.EQ.2)NBPGAU=1
  143. IF(IPOSI.EQ.3)NBPGAU=INFELE(6)
  144. IF(IPOSI.EQ.4)NBPGAU=INFELE(3)
  145. IF(IPOSI.EQ.5)NBPGAU=INFELE(4)
  146. endif
  147. ENDIF
  148.  
  149.  
  150. SEGDES,MELEME
  151. IF(IENT2.GT.NBPGAU)THEN
  152. INTERR(1)=IENT2
  153. INTERR(2)=NBPGAU
  154. INTERR(3)=IENT3
  155. CALL ERREUR(8004)
  156. SEGDES,IMODEL
  157. RETURN
  158. ENDIF
  159. *
  160. * ON CONSTRUIT LE MCHAML
  161. *
  162. L1=LTYPE
  163. N1=1
  164. N3=6
  165. SEGINI,MCHELM
  166. TITCHE=CHATYPE(1:LTYPE)
  167. CONCHE(1)=CONMOD
  168. SEGDES,IMODEL
  169. IMACHE(1)=MELEME
  170. IFOCHE=IFOUR
  171. INFCHE(1,1) = 0
  172. INFCHE(1,2) = 0
  173. INFCHE(1,3) = NIFOUR
  174. INFCHE(1,4) = MINTE
  175. INFCHE(1,5) = 0
  176. INFCHE(1,6) = IPOSI
  177. *
  178. N2=1
  179. SEGINI,MCHAML
  180. ICHAML(1)=MCHAML
  181. NOMCHE(1)=MOCHOI
  182. IF (IRETF.EQ.0) THEN
  183. TYPCHE(1)='POINTEUR'//TYPOBJ
  184. N1PTEL=0
  185. N1EL=0
  186. N2PTEL=NBPGAU
  187. N2EL=NBELEM
  188. SEGINI,MELVAL
  189. DO IB=1,NBELEM
  190. DO IGAU=1,NBPGAU
  191. IELCHE(IGAU,IB)=0
  192. END DO
  193. END DO
  194. IELCHE(IENT2,IENT1)=IPOBJ
  195. ELSE
  196. TYPCHE(1)='REAL*8 '
  197. N2PTEL=0
  198. N2EL=0
  199. N1PTEL=NBPGAU
  200. N1EL=NBELEM
  201. SEGINI,MELVAL
  202. DO IB=1,NBELEM
  203. DO IGAU=1,NBPGAU
  204. VELCHE(IGAU,IB)=0.D0
  205. END DO
  206. END DO
  207. VELCHE(IENT2,IENT1)=XFLOT
  208. ENDIF
  209. IELVAL(1)=MELVAL
  210. SEGDES,MELVAL,MCHAML,MCHELM
  211. *
  212. * ON SORT
  213. *
  214. CALL ECROBJ('MCHAML ',MCHELM)
  215. RETURN
  216. END
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  

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