Télécharger manuci.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUCI SOURCE CB215821 17/01/16 21:16:15 9279
  2. SUBROUTINE MANUCI(IPMODL,MOT1,MOT2,IEN1,IEN2,IEN3,XFLO, IPRES)
  3. *______________________________________________________________________
  4. *
  5. * Donne une valeur en 1 point pour un MCHAML
  6. * Appele par MANUCE
  7. *
  8. *
  9. * Entrees :
  10. * ---------
  11. *
  12. * IPMODL Pointeur sur un MMODEL
  13. * MOT1 Mot indiquant le type du MCHAML a creer
  14. * MOT2 Nom de la composante concernee
  15. * IEN1 Numero de l'element
  16. * ENT2 Numero du point de gauss
  17. * ENT3 Numero de la sous zone concernee
  18. * (vaut 1 par defaut - cf. MANUCE)
  19. * XFLO Flottant ( Valeur de la composante MOT2 )
  20. *
  21. *
  22. * Sortie :
  23. * --------
  24. *
  25. * IPRES Pointeur sur le MCHAML resultat (=0 si erreur)
  26. *
  27. * EBERSOLT JANVIER 86
  28. *
  29. * Passage aux nouveaux MCHAMLs par JM CAMPENON le 06/91
  30. *
  31. *______________________________________________________________________
  32. *
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8(A-H,O-Z)
  35. *
  36. -INC SMMODEL
  37. -INC SMCHAML
  38. -INC SMELEME
  39. -INC SMINTE
  40. -INC CCOPTIO
  41. *
  42. CHARACTER*(*) MOT1, MOT2
  43. *
  44. SEGMENT INFO
  45. INTEGER INFELL(JG)
  46. ENDSEGMENT
  47. *
  48. PARAMETER (NMOT=22)
  49. CHARACTER*8 LISMOT(NMOT)
  50. CHARACTER*50 LISTIT(NMOT)
  51. INTEGER MSUPPO(NMOT)
  52. LOGICAL LSUPNO
  53. *
  54. EXTERNAL LONG
  55. *
  56. DATA LISMOT / 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ',
  57. 1 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL',
  58. 1 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  59. 1 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  60. 1 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  61. 1 'GRAFLEXI', 'VONMISES'/
  62. *
  63. * LES MATERIAU ET CARACTERISTIQUE SONT MIS AUX NOEUDS
  64. *
  65. * 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ',
  66. DATA MSUPPO / 0 , 2 , 3 , 4 ,
  67. * 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL',
  68. 1 5 , 0 , 0 , 0 ,
  69. * 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  70. 1 3 , 5 , 5 , 5 ,
  71. * 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  72. 1 0 , 0 , 5 , 5 ,
  73. * 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  74. 1 3 , 5 , 5 , 5 ,
  75. * 'GRAFLEXI', 'VONMISES'/
  76. 1 5 , 5 /
  77. *
  78. DATA LISTIT / 'NOEUD', 'GRAVITE', 'RIGIDITE', 'MASSE',
  79. 1 'STRESSES', 'DEPLACEMENTS', 'FORCES',
  80. 1 'REACTUALISATION', 'FORCES VOLUMIQUES',
  81. 1 'GRADIENT', 'CONTRAINTES', 'DEFORMATIONS',
  82. 1 'CARACTERISTIQUES', 'CARACTERISTIQUES',
  83. 1 'TEMPERATURES', 'CONTRAINTES PRINCIPALES',
  84. 1 'MATRICE DE HOOKE', 'MATRICE DE HOOKE TANGENTE',
  85. 1 'DILATATIONS', 'VARIABLES INTERNES',
  86. 1 'GRADIENT DE FLEXION','VON MISES'/
  87. *
  88. IPRES = 0
  89. *
  90. NHRM=NIFOUR
  91. *
  92. MMODEL=IPMODL
  93. SEGACT MMODEL
  94. NSOUS=KMODEL(/1)
  95. *
  96. IF (IEN3.GT.NSOUS) THEN
  97. CALL ERREUR (279)
  98. GOTO 990
  99. ENDIF
  100. *
  101. * CREATION DU MCHELM
  102. * On ne cree qu'un MCHAML a une sous zone
  103. *
  104. CALL PLACE(LISMOT,NMOT,IPLAC,MOT1)
  105. L1=LONG(LISTIT(IPLAC))
  106. N1=1
  107. IF (MSUPPO(IPLAC).EQ.0) THEN
  108. N3=3
  109. ELSE
  110. N3=6
  111. ENDIF
  112. SEGINI MCHELM
  113. TITCHE=LISTIT(IPLAC)(1:L1)
  114. IFOCHE=IFOUR
  115. *
  116. * On active la sous zone concernee
  117. *
  118. IMODEL=KMODEL(IEN3)
  119. SEGACT IMODEL
  120. IF(INFMOD(/1).NE.0) THEN
  121. NPINT=INFMOD(1)
  122. ELSE
  123. NPINT = 0
  124. ENDIF
  125. IPMAIL=IMAMOD
  126. MELEME=IMAMOD
  127. MELE =NEFMOD
  128. MFR=NUMMFR(MELE)
  129. *
  130. SEGACT MELEME
  131. NBELEM=NUM(/2)
  132. IF (MSUPPO(IPLAC).EQ.0) THEN
  133. NBPGAU=NUM(/1)
  134. ENDIF
  135. SEGDES MELEME
  136. *
  137. IMACHE(1)=IPMAIL
  138. CONCHE(1)=CONMOD
  139. INFCHE(1,1)=0
  140. INFCHE(1,2)=0
  141. INFCHE(1,3)=NHRM
  142. IF (N3.GT.3) INFCHE(1,5)=0
  143. *
  144. lsupno=.true.
  145. MOCOMP=0
  146. *
  147. IF (MSUPPO(IPLAC).NE.0) THEN
  148. if(infmod(/1).lt.2+msuppo(iplac)) then
  149. CALL ELQUOI(MELE,0,MSUPPO(IPLAC),IPINF,IMODEL)
  150. IF (IERR.NE.0) GOTO 991
  151. INFO=IPINF
  152. MINTE=INFELL(11)
  153. SEGSUP INFO
  154. else
  155. minte=infmod(2+msuppo(iplac))
  156. endif
  157. *
  158. SEGACT MINTE
  159. NBPGAU=POIGAU(/1)
  160. SEGDES MINTE
  161. ENDIF
  162. *
  163. * Si le numero du point de gauss ou de l'element est trop eleve
  164. *
  165. IF(IEN2.GT.NBPGAU.OR.IEN1.GT.NBELEM) THEN
  166. CALL ERREUR(262)
  167. GOTO 991
  168. ENDIF
  169. *
  170. IF (N3.GT.3) THEN
  171. INFCHE(1,4)=MINTE
  172. INFCHE(1,6)=MSUPPO(IPLAC)
  173. ENDIF
  174. *
  175. * AIGUILLAGE SUIVANT MOT CLE
  176. *
  177. GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2,
  178. 1 99,20,99,99) IPLAC
  179. *
  180. 99 MOTERR(1:8)='MCHAML '
  181. CALL ERREUR(302)
  182. GOTO 991
  183. *
  184. 1 NBROBL=1
  185. NBRFAC=0
  186. SEGINI NOMID
  187. MOCOMP=NOMID
  188. LESOBL(1)='SCAL'
  189. GOTO 120
  190. *
  191. 2 NBROBL=1
  192. NBRFAC=0
  193. SEGINI NOMID
  194. MOCOMP=NOMID
  195. LESOBL(1)='MAHO'
  196. GOTO 120
  197. *
  198. 6 if(lnomid(1).ne.0) then
  199. mocomp=lnomid(1)
  200. lsupno=.false.
  201. else
  202. CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  203. endif
  204. GOTO 120
  205. *
  206. 7 if(lnomid(2).ne.0) then
  207. mocomp=lnomid(2)
  208. lsupno=.false.
  209. else
  210. CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  211. endif
  212. GOTO 120
  213. *
  214. 10 if(lnomid(3).ne.0) then
  215. mocomp=lnomid(3)
  216. lsupno=.false.
  217. else
  218. CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  219. endif
  220. GOTO 120
  221. *
  222. 11 if(lnomid(4).ne.0) then
  223. MOCOMP=lnomid(4)
  224. lsupno=.false.
  225. else
  226. CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  227. endif
  228. GOTO 120
  229. *
  230. 12 IF(lnomid(5).ne.0) then
  231. mocomp=lnomid(5)
  232. lsupno=.false.
  233. else
  234. CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  235. endif
  236. GOTO 120
  237. *
  238. 13 if(lnomid(6).ne.0) then
  239. MOCOMP=lnomid(6)
  240. lsupno=.false.
  241. else
  242. CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  243. endif
  244. GOTO 120
  245. *
  246. 14 if(lnomid(7).ne.0) then
  247. MOCOMP=lnomid(7)
  248. lsupno=.false.
  249. else
  250. CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
  251. endif
  252. GOTO 120
  253. *
  254. 15 if(lnomid(8).ne.0) then
  255. MOCOMP=lnomid(8)
  256. lsupno=.false.
  257. else
  258. CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
  259. endif
  260. GOTO 120
  261. *
  262. 16 if(lnomid(9).ne.0) then
  263. MOCOMP=lnomid(9)
  264. lsupno=.false.
  265. else
  266. CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  267. endif
  268. GOTO 120
  269. *
  270. 20 if(lnomid(10).ne.0) then
  271. MOCOMP=lnomid(10)
  272. lsupno=.false.
  273. else
  274. CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  275. endif
  276. GOTO 120
  277. *
  278. 120 CONTINUE
  279. NOMID=MOCOMP
  280. SEGACT NOMID
  281. nobl=lesobl(/2)
  282. nfac=lesfac(/2)
  283. IF (NOBL.EQ.0.AND.NFAC.EQ.0) THEN
  284. CALL ERREUR(404)
  285. GOTO 992
  286. ENDIF
  287. *
  288. IPLAO=0
  289. IPLAF=0
  290. *
  291. CALL PLACE(LESOBL,NOBL,IPLAO,MOT2)
  292. *
  293. IF (IPLAO.EQ.0) THEN
  294. CALL PLACE(LESFAC,NFAC,IPLAF,MOT2)
  295. IF(IPLAF.EQ.0) THEN
  296. MOTERR(1:4)=MOT1
  297. MOTERR(5:8)=MOT2
  298. CALL ERREUR(260)
  299. GOTO 992
  300. ENDIF
  301. ENDIF
  302. *
  303. * Creation du MCHAML
  304. *
  305. N2=NOBL+NFAC
  306. SEGINI MCHAML
  307. ICHAML(1)=MCHAML
  308. N1PTEL=NBPGAU
  309. N1EL=NBELEM
  310. N2PTEL=0
  311. N2EL=0
  312. DO 130 ICOMP=1,NOBL
  313. NOMCHE(ICOMP)=LESOBL(ICOMP)
  314. TYPCHE(ICOMP)='REAL*8'
  315. SEGINI MELVAL
  316. IELVAL(ICOMP)=MELVAL
  317. DO 230 IGAU=1,N1PTEL
  318. DO 230 IB=1,N1EL
  319. VELCHE(IGAU,IB)=0.D0
  320. 230 CONTINUE
  321. IF (IPLAO.EQ.ICOMP) THEN
  322. VELCHE(IEN2,IEN1)=XFLO
  323. ENDIF
  324. SEGDES MELVAL
  325. 130 CONTINUE
  326. *
  327. * CORRECTIONS PP DEC92 : DECALAGE DE NOBL
  328. *
  329. DO 140 ICOMP=1,NFAC
  330. NOMCHE(ICOMP+NOBL)=LESFAC(ICOMP)
  331. TYPCHE(ICOMP+NOBL)='REAL*8'
  332. SEGINI MELVAL
  333. IELVAL(ICOMP+NOBL)=MELVAL
  334. DO 240 IGAU=1,N1PTEL
  335. DO 240 IB=1,N1EL
  336. VELCHE(IGAU,IB)=0.D0
  337. 240 CONTINUE
  338. IF (IPLAF.EQ.ICOMP) THEN
  339. VELCHE(IEN2,IEN1)=XFLO
  340. ENDIF
  341. SEGDES MELVAL
  342. 140 CONTINUE
  343. *
  344. SEGDES MCHELM
  345. IPRES=MCHELM
  346.  
  347. 992 CONTINUE
  348. IF (lsupno) SEGSUP,NOMID
  349. 991 CONTINUE
  350. SEGDES,IMODEL
  351. IF (IERR.NE.0) THEN
  352. SEGSUP,MCHELM
  353. IPRES=0
  354. ENDIF
  355. 990 CONTINUE
  356. SEGDES MMODEL
  357.  
  358. RETURN
  359. END
  360.  
  361.  
  362.  
  363.  
  364.  

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