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

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