Télécharger masse2.eso

Retour à la liste

Numérotation des lignes :

  1. C MASSE2 SOURCE BP208322 15/06/22 21:20:36 8543
  2. SUBROUTINE MASSE2(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,
  3. &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,ILUMP,IIPDPG)
  4. *---------------------------------------------------------------------*
  5. * _________________________________ *
  6. * | | *
  7. * | calcul de la matrice de masse | *
  8. * |________________________________| *
  9. * *
  10. * massif, liquide, 'surface libre ,incompressible *
  11. * *
  12. *---------------------------------------------------------------------*
  13. * *
  14. * entrees : *
  15. * ________ *
  16. * *
  17. * ipmail pointeur sur un segment meleme *
  18. * nddl nombre de degre de liberte /noeud *
  19. * lre nombre de ddl dans la matrice de masse *
  20. * nbpgau nombre de point d'integration pour la masse *
  21. * ipmint pointeur sur un segment minte *
  22. * ipmin1 pointeur sur un segment minte (aux noeuds) *
  23. * mele numero de l'element fini *
  24. * mfr numero de la formulation * *
  25. * ivamat pointeur sur un segment mptval pour le materiau ou *
  26. * pour une matrice de hooke *
  27. * ivacar pointeur sur un segment mptval pour les *
  28. * caracteristiques *
  29. * nmatt nombre de composante de materiau (imat=1) * *
  30. * ilump =1 si l'opérateur LUMP est appelé
  31. * *
  32. * sorties : *
  33. * ________ *
  34. * *
  35. * ipmatr pointeur sur la matrice de masse de la sous-zone *
  36. * *
  37. *---------------------------------------------------------------------*
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8(A-H,O-Z)
  40. -INC CCOPTIO
  41. -INC CCHAMP
  42. -INC CCREEL
  43. -INC SMRIGID
  44. -INC SMCHAML
  45. -INC SMELEME
  46. -INC SMCOORD
  47. -INC SMINTE
  48. -INC SMMODEL
  49. c
  50. SEGMENT WRK1
  51. REAL*8 REL(LRE,LRE),XE(3,NBBB)
  52. ENDSEGMENT
  53. c
  54. SEGMENT WRK2
  55. REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  56. ENDSEGMENT
  57. c
  58. SEGMENT WRK5
  59. REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE)
  60. REAL*8 BLT(NDDL,LRE)
  61. ENDSEGMENT
  62. c
  63. c
  64. SEGMENT WRK6
  65. REAL*8 PROPEL(1)
  66. REAL*8 OUT(5)
  67. REAL*8 WORK1(24*24)
  68. ENDSEGMENT
  69. c
  70. SEGMENT MVELCH
  71. REAL*8 VALMAT(NV1)
  72. ENDSEGMENT
  73. c
  74. c
  75. SEGMENT MPTVAL
  76. INTEGER IPOS(NS),NSOF(NS)
  77. INTEGER IVAL(NCOSOU)
  78. CHARACTER*16 TYVAL(NCOSOU)
  79. ENDSEGMENT
  80. c
  81. *
  82. MELEME=IPMAIL
  83. NBNN=NUM(/1)
  84. NBELEM=NUM(/2)
  85. *
  86. NV1=NMATT
  87. SEGINI,MVELCH
  88. *
  89. xMATRI=IPMATR
  90. LVAL = (LRE*(LRE+1))/2
  91. NLIGRP=LRE
  92. NLIGRD=LRE
  93. *
  94. * introduction du point autour duquel se fait le mouvement
  95. * de la section en defo plane generalisee
  96. * En 1D : pas de rotation
  97. IF (IFOUR.EQ.-3) THEN
  98. IREF=(IIPDPG-1)*(IDIM+1)
  99. XDPGE=XCOOR(IREF+1)
  100. YDPGE=XCOOR(IREF+2)
  101. ELSE
  102. XDPGE=0.D0
  103. YDPGE=0.D0
  104. ENDIF
  105. *
  106. NHRM=NIFOUR
  107. *
  108. MINTE=IPMINT
  109.  
  110. c_______________________________________________________________________
  111. c
  112. c numero des etiquettes :
  113. c etiquettes de 1 a 98 pour traitement specifique a l element
  114. c dans la zone specifique a chaque element commencant par :
  115. c 5 continue
  116. c element 5 etiquettes 1005 2005 3005 4005 ...
  117. c 44 continue
  118. c element 44 etiquettes 1044 2044 3044 4044 ...
  119. c_______________________________________________________________________
  120. c
  121. GOTO (99,99,99,4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  122. 199,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,35,35,35,35,35,35,
  123. 299,99,99,99,99,99,99,48,99,99,99,99,48,48,99,99,99,99,99,99,
  124. 399,99,99,99,99,99,99,99, 4, 4, 4, 4, 4,99,99, 4,99,99,99,99,
  125. 499,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  126. 599,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  127. 64, 4),MELE
  128. * BCN
  129. IF ((MELE.eq.183).or.(MELE.eq.184)) GOTO 4
  130. * BCN
  131. C= Elements MECANIQUE 1D : M1Dx
  132. IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  133. IF (MELE.EQ.260) GOTO 5
  134.  
  135. GOTO 99
  136. c_______________________________________________________________________
  137. c_______________________________________________________________________
  138. c
  139. c secteur de calcul pour les elements massifs et elements incompressibles
  140. c_______________________________________________________________________
  141. c
  142. 4 CONTINUE
  143. DIM3=1.D0
  144. NBNO=NBNN
  145. NBBB=NBNN
  146. SEGINI WRK1,WRK2
  147. I195=0
  148. I259=0
  149. DO 3004 IB=1,NBELEM
  150. c
  151. c on cherche les coordonnees des noeuds de l element ib
  152. c
  153. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  154. CALL ZERO (REL,LRE,LRE)
  155. c
  156. c boucle sur les points de gauss
  157. c
  158. ISDJC=0
  159. DO 4004 IGAU=1,NBPGAU
  160. c
  161. c recuperation de l'epaisseur
  162. c
  163. IF (IFOUR.EQ.-2)THEN
  164. MPTVAL=IVACAR
  165. IF (IVACAR.NE.0) THEN
  166. MELVAL=IVAL(1)
  167. IF (MELVAL.NE.0) THEN
  168. IGMN=MIN(IGAU,VELCHE(/1))
  169. IBMN=MIN(IB,VELCHE(/2))
  170. DIM3=VELCHE(IGMN,IBMN)
  171. ELSE
  172. DIM3=1.D0
  173. ENDIF
  174. ENDIF
  175. ENDIF
  176. *
  177. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  178. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  179. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  180. IF(DJAC.EQ.0.) I259=IB
  181. DJAC=ABS(DJAC)*POIGAU(IGAU)
  182. MPTVAL=IVAMAT
  183. IF (IVAL(1).NE.0) THEN
  184. MELVAL=IVAL(1)
  185. IGMN=MIN(IGAU,VELCHE(/1))
  186. IBMN=MIN(IB,VELCHE(/2))
  187. VALMAT(1)=VELCHE(IGMN,IBMN)
  188. ELSE
  189. VALMAT(1)=0.D0
  190. ENDIF
  191. DJAC=DJAC*VALMAT(1)
  192. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  193. 4004 CONTINUE
  194. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  195. * SEGINI XMATRI
  196. * IMATTT(IB)=XMATRI
  197. c
  198. c remplissage de xmatri
  199. c
  200. IF ( ILUMP .EQ. 0 ) THEN
  201. CALL REMPMT(REL,LRE,RE(1,1,ib))
  202. ELSE
  203. c
  204. c cas de l'opérateur LUMP
  205. c
  206. IF (MELE.EQ.4) THEN
  207. * lumping par la méthode physique
  208. CALL LUMP1(REL,LRE,RE(1,1,ib),IFOUR)
  209. ELSE
  210. * lumping par la méthode HRZ
  211. CALL LUMP2(REL,LRE,RE(1,1,ib),IFOUR)
  212. ENDIF
  213. ENDIF
  214. * SEGDES XMATRI
  215. 3004 CONTINUE
  216. IF(I195.NE.0) INTERR(1)=I195
  217. IF(I195.NE.0) CALL ERREUR(195)
  218. IF(I259.NE.0) INTERR(1)=I259
  219. IF(I259.NE.0) CALL ERREUR(259)
  220. SEGDES xMATRI
  221. SEGSUP WRK1,WRK2,MVELCH
  222. GOTO 510
  223. c_______________________________________________________________________
  224. c_______________________________________________________________________
  225. c_______________________________________________________________________
  226. c
  227. c secteur de calcul pour element SHB8
  228. c_______________________________________________________________________
  229. c
  230. 5 CONTINUE
  231. NBNO=NBNN
  232. NBBB=NBNN
  233. SEGINI WRK1,WRK2,WRK6
  234. DO 3005 IB=1,NBELEM
  235. c
  236. c on cherche les coordonnees des noeuds de l element ib
  237. c
  238. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  239. CALL ZERO (REL,LRE,LRE)
  240. c
  241. *
  242. MPTVAL=IVAMAT
  243. IF (IVAL(1).NE.0) THEN
  244. MELVAL=IVAL(1)
  245. IBMN=MIN(IB,VELCHE(/2))
  246. VALMAT(1)=VELCHE(1,IBMN)
  247. ELSE
  248. VALMAT(1)=0.D0
  249. ENDIF
  250.  
  251. PROPEL(1)=VALMAT(1)
  252. C
  253. C CALCUL DE LA MATRICE DE MASSE
  254. C
  255. call SHB8 (3,XE,DDHOOK,PROPEL,WORK1,REL,OUT)
  256. C
  257. * SEGINI XMATRI
  258. * IMATTT(IB)=XMATRI
  259. c
  260. c remplissage de xmatri
  261. c
  262. CALL REMPMT(REL,LRE,RE(1,1,ib))
  263. * SEGDES XMATRI
  264. 3005 CONTINUE
  265.  
  266. SEGDES xMATRI
  267. SEGSUP WRK1,WRK2,WRK6,MVELCH
  268. GOTO 510
  269. c_______________________________________________________________________
  270. c_______________________________________________________________________
  271. c
  272. c secteur de calcul pour les elements liquides
  273. c_______________________________________________________________________
  274. c
  275. 35 CONTINUE
  276. c
  277. c ces éléments n'ont pas été testé pour l'opérateur LUMP
  278. c
  279. IF ( ILUMP .EQ. 1 ) GOTO 99
  280. c
  281. DIM3=1.D0
  282. NBNO=NBNN
  283. NBBB=NBNN
  284. SEGINI WRK1,WRK2,WRK5
  285. I195=0
  286. DO 3035 IB=1,NBELEM
  287. c
  288. c on cherche les coordonnees des noeuds de l element ib
  289. c
  290. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  291. CALL ZERO (REL,LRE,LRE)
  292.  
  293. c
  294. c calcul des termes en p*pi
  295.  
  296. ISDJC=0
  297. DO 4035 IGAU=1,NBPGAU
  298.  
  299. c calcul des coefficients de normalisation et proprietes materielles
  300. MPTVAL=IVAMAT
  301. DO 6035 IM=1,NMATT
  302. IF (IVAL(IM).NE.0) THEN
  303. MELVAL=IVAL(IM)
  304. IGMN=MIN(IGAU,VELCHE(/1))
  305. IBMN=MIN(IB,VELCHE(/2))
  306. VALMAT(IM)=VELCHE(IGMN,IBMN)
  307. ELSE
  308. VALMAT(IM)=0.D0
  309. ENDIF
  310. 6035 CONTINUE
  311. RHO = VALMAT(1)
  312. C = VALMAT(2)
  313. RHOREF= VALMAT(3)
  314. CREF = VALMAT(4)
  315. RLCAR = VALMAT(5)
  316. c
  317. COEFPR= (RHOREF*CREF**2)/RLCAR
  318. COEFPI= RHOREF*RLCAR
  319. VML12 =-(COEFPR*COEFPI)/(RHO*C**2)
  320. VML22 =-(COEFPI**2)/RHO
  321.  
  322. c
  323. c recuperation de l'epaisseur
  324. c
  325. IF (IFOUR.EQ.-2)THEN
  326. MPTVAL=IVACAR
  327. IF (IVACAR.NE.0) THEN
  328. MELVAL=IVAL(1)
  329. IF (MELVAL.NE.0) THEN
  330. IGMN=MIN(IGAU,VELCHE(/1))
  331. IBMN=MIN(IB,VELCHE(/2))
  332. DIM3=VELCHE(IGMN,IBMN)
  333. ELSE
  334. DIM3=1.D0
  335. ENDIF
  336. ENDIF
  337. ENDIF
  338. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  339. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  340. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  341. DJAC=ABS(DJAC)*POIGAU(IGAU)
  342. CALL NMLNST(BGENE,DJAC,VML12,LRE,NDDL,REL)
  343.  
  344. c
  345. c calcul des termes en pi*pi
  346. c
  347.  
  348. CALL BLMAST(IGAU,MFR,NBNN,LRE,IFOUR,NDDL,NHRM,
  349. 1 XE,SHPTOT,SHPWRK,BLX,BLY,BLZ,BLT,DJAC)
  350. DJAC=ABS(DJAC)*POIGAU(IGAU)
  351. CALL BMLBST(BLX,BLY,BLZ,BLT,DJAC,VML22,IFOUR,LRE,NDDL,REL)
  352. 4035 CONTINUE
  353. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  354.  
  355. * SEGINI XMATRI
  356. * IMATTT(IB)=XMATRI
  357. c
  358. c remplissage de xmatri
  359. c
  360. CALL REMPMT(REL,LRE,RE(1,1,ib))
  361. * SEGDES XMATRI
  362. 3035 CONTINUE
  363. IF(I195.NE.0) INTERR(1)=I195
  364. IF(I195.NE.0) CALL ERREUR(195)
  365. SEGDES xMATRI
  366. SEGSUP WRK1,WRK2,WRK5,MVELCH
  367. GOTO 510
  368. c_______________________________________________________________________
  369. c
  370. c secteur de calcul pour les elements de surface libre
  371. c_______________________________________________________________________
  372. c
  373. 48 CONTINUE
  374. c
  375. c ces éléments n'ont pas été testé pour l'opérateur LUMP
  376. c
  377. IF ( ILUMP .EQ. 1 ) GOTO 99
  378. c
  379. NBNO=NBNN
  380. NBBB=NBNN
  381. SEGINI WRK1,WRK2
  382. I195=0
  383. DO 3048 IB=1,NBELEM
  384. c
  385. c on cherche les coordonnees des noeuds de l element ib
  386. c
  387. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  388. CALL ZERO (REL,LRE,LRE)
  389. c
  390. c calcul du coefficient de normalisation sur pi
  391. c
  392. MPTVAL=IVAMAT
  393. DO 5048 IM=1,NMATT
  394. MELVAL=IVAL(IM)
  395. IBMN=MIN(IB,VELCHE(/2))
  396. VALMAT(IM)=VELCHE(1,IBMN)
  397. 5048 CONTINUE
  398. RHOREF=VALMAT(1)
  399. RLCAR = VALMAT(2)
  400. c
  401. COEFPI= RHOREF*RLCAR
  402. VMS =-COEFPI
  403. c
  404. c boucle sur les points de gauss
  405. c
  406. ISDJC=0
  407. DO 4048 IGAU=1,NBPGAU
  408. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  409. 1 1.D0,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  410. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  411. DJAC=ABS(DJAC)*POIGAU(IGAU)
  412. CALL NMSNST(BGENE,DJAC,VMS,LRE,NDDL,REL)
  413. 4048 CONTINUE
  414. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  415. * SEGINI XMATRI
  416. * IMATTT(IB)=XMATRI
  417. c
  418. c remplissage de xmatri
  419. c
  420. CALL REMPMT(REL,LRE,RE(1,1,ib))
  421. * SEGDES XMATRI
  422. 3048 CONTINUE
  423. IF(I195.NE.0) INTERR(1)=I195
  424. IF(I195.NE.0) CALL ERREUR(195)
  425. SEGDES xMATRI
  426. SEGSUP WRK1,WRK2,MVELCH
  427. GOTO 510
  428. c_______________________________________________________________________
  429. *
  430. 99 CONTINUE
  431. MOTERR(1:4)=NOMTP(MELE)
  432. MOTERR(5:12)='MASSE2'
  433. CALL ERREUR(86)
  434. *
  435. 510 CONTINUE
  436. RETURN
  437. END
  438.  
  439.  
  440.  
  441.  
  442.  

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