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

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