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

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