Télécharger masse4.eso

Retour à la liste

Numérotation des lignes :

  1. C MASSE4 SOURCE BP208322 15/06/22 21:20:39 8543
  2. SUBROUTINE MASSE4(IPMAIL,LW,LRE,IVAMAT,NMATT,IVACAR,NCARR,
  3. &IVECT,NBPGAU,IPMINT,NDDL,MELE,MFR,IPMATR,ILUMP,
  4. &ISOUS,IIPDPG,IMOD)
  5. *---------------------------------------------------------------------*
  6. * ________________________________ *
  7. * | | *
  8. * | calcul de la matrice de masse | *
  9. * |________________________________| *
  10. * *
  11. * raccords liquide/massifs,raccords liquide/coque,barre,homogenise *
  12. * cerce,joints 2-3d *
  13. * *
  14. *---------------------------------------------------------------------*
  15. * *
  16. * entrees : *
  17. * ________ *
  18. * *
  19. * ipmail pointeur sur un segment meleme *
  20. * lw dimension du tableau de travail de l'element *
  21. * lre nombre de ddl dans la matrice de masse *
  22. * ivamat pointeur sur un segment mptval pour le materiau *
  23. * nmatt nombre de composante de materiau (imat=1) *
  24. * ivacar pointeur sur un segment mptval pour les caracteri- *
  25. * stiques *
  26. * ncarr nombre de caracteristiques geometriques *
  27. * ivect flag indiquant si on a entree les axes locaux *
  28. * nbpgau nombre de point d'integration pour la masse *
  29. * ipmint pointeur sur un segment minte *
  30. * ipmin1 pointeur sur un segment minte (aux noeuds) *
  31. * nddl nombre de degre de liberte /noeud *
  32. * mele numero de l'element fini *
  33. * nbpgmi nombre de noeuds /element *
  34. * ilump =1 si l'op�ateur LUMP est appel� *
  35. * *
  36. * sorties : *
  37. * ________ *
  38. * *
  39. * ipmatr pointeur sur la matrice de masse de la sous-zone *
  40. * *
  41. *---------------------------------------------------------------------*
  42. IMPLICIT INTEGER(I-N)
  43. IMPLICIT REAL*8(A-H,O-Z)
  44. -INC CCOPTIO
  45. -INC CCHAMP
  46. -INC CCREEL
  47. -INC SMRIGID
  48. -INC SMCHAML
  49. -INC SMELEME
  50. -INC SMCOORD
  51. -INC SMINTE
  52. -INC SMMODEL
  53. -INC SMLMOTS
  54. c
  55. SEGMENT WRK1
  56. REAL*8 REL(LRE,LRE),XE(3,NBBB)
  57. ENDSEGMENT
  58. c
  59. SEGMENT WRK2
  60. REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  61. ENDSEGMENT
  62. c
  63. SEGMENT WRK3
  64. REAL*8 WORK(LW)
  65. ENDSEGMENT
  66. *
  67. SEGMENT WRK4
  68. REAL*8 BPSS(3,3),XEL(3,NBBB)
  69. ENDSEGMENT
  70. *
  71. SEGMENT WRK5
  72. REAL*8 XGENE(NCOM,LRN)
  73. ENDSEGMENT
  74. *
  75. SEGMENT MVELCH
  76. REAL*8 VALMAT(NV1)
  77. ENDSEGMENT
  78. c
  79. SEGMENT MPTVAL
  80. INTEGER IPOS(NS),NSOF(NS)
  81. INTEGER IVAL(NCOSOU)
  82. CHARACTER*16 TYVAL(NCOSOU)
  83. ENDSEGMENT
  84.  
  85. CHARACTER*8 CMATE
  86. CHARACTER*4 lesinc(7),lesdua(7)
  87. DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/
  88. DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/
  89. *
  90. MELEME=IPMAIL
  91. NBNN=NUM(/1)
  92. NBELEM=NUM(/2)
  93. *
  94. NV1=NMATT
  95. SEGINI,MVELCH
  96. *
  97. xMATRI=IPMATR
  98. * lval = (lre*(lre+1))/2
  99. NLIGRP=LRE
  100. NLIGRD=LRE
  101. *
  102. * introduction du point autour duquel se fait le mouvement
  103. * de la section en defo plane generalisee
  104. *
  105. IF (IFOUR.EQ.-3.AND.MFR.NE.35) THEN
  106. IP=IIPDPG
  107. SEGACT MCOORD
  108. IREF=(IP-1)*(IDIM+1)
  109. XDPGE=XCOOR(IREF+1)
  110. YDPGE=XCOOR(IREF+2)
  111. ELSE
  112. XDPGE=0.D0
  113. YDPGE=0.D0
  114. ENDIF
  115. *
  116. NHRM=NIFOUR
  117. *
  118. MINTE=IPMINT
  119. *
  120. IMODEL = IMOD
  121. CMATE = CMATEE
  122. jmat = 0
  123. iinc=0
  124. idua=0
  125. DO imat = 1 , matmod(/2)
  126. if (matmod(imat).eq.'IMPEDANCE') then
  127. jmat = imat
  128. goto 45
  129. endif
  130. ENDDO
  131. IF (mfr.eq.28) THEN
  132. jgn = 4
  133. if (ifour.eq.2) then
  134. jgm = 6
  135. segini mlmots
  136. iinc = mlmots
  137. do igm = 1,jgm
  138. mots(igm) = lesinc(igm)
  139. enddo
  140. segini mlmots
  141. idua = mlmots
  142. do igm= 1,jgm
  143. mots(igm) = lesdua(igm)
  144. enddo
  145. else if (ifour.lt.0) then
  146. jgm = 4
  147. segini mlmots
  148. iinc = mlmots
  149. mots(1) = lesinc(1)
  150. mots(2) = lesinc(2)
  151. mots(3) = lesinc(4)
  152. mots(4) = lesinc(5)
  153. segini mlmots
  154. idua = mlmots
  155. mots(1) = lesdua(1)
  156. mots(2) = lesdua(2)
  157. mots(3) = lesdua(4)
  158. mots(4) = lesdua(5)
  159. else if (ifour.eq.0) then
  160. jgm = 3
  161. segini mlmots
  162. iinc = mlmots
  163. mots(1) = lesinc(7)
  164. mots(2) = lesinc(3)
  165. mots(3) = lesinc(6)
  166. segini mlmots
  167. idua = mlmots
  168. mots(1) = lesdua(7)
  169. mots(2) = lesdua(3)
  170. mots(3) = lesdua(6)
  171. else if (ifour.eq.1) then
  172. * a faire
  173. endif
  174. ENDIF
  175.  
  176. c
  177. c numero des etiquettes :
  178. c etiquettes de 1 a 98 pour traitement specifique a l element
  179. c dans la zone specifique a chaque element commencant par :
  180. c 5 continue
  181. c element 5 etiquettes 1005 2005 3005 4005 ...
  182. c 44 continue
  183. c element 44 etiquettes 1044 2044 3044 4044 ...
  184. c_______________________________________________________________________
  185. c
  186. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  187. GOTO ( 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  188. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  189. & , 12, 99, 99, 99, 99, 99, 18, 18, 99, 99, 99
  190. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  191. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  192. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  193. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  194. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  195. & , 45, 46, 47, 99, 99, 99, 99, 99, 99, 99, 55
  196. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  197. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  198. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  199. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  200. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  201. & , 99, 99, 99, 99, 99, 99, 99, 85, 99, 87, 88
  202. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  203. & , 99, 99, 99, 92, 99, 94, 46, 99, 99, 12, 99
  204. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  205. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  206. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  207. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  208. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  209. & , 99, 46, 124, 99, 126, 127, 99, 99, 99, 99, 99
  210. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  211. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  212. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  213. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  214. * TE56 PY91 TRH6
  215. & , 99, 99, 157),MELE
  216. *
  217. GOTO(168,169,170,171,172),MELE-167
  218. *
  219. * JOI1
  220. GOTO(265),MELE-264
  221.  
  222. c
  223.  
  224. GOTO 99
  225. c_______________________________________________________________________
  226. c
  227. c secteur de calcul pour les elements de raccord rac2 rac3 litu
  228. c liquide massif lineaire cas bidimensionnel
  229. c_______________________________________________________________________
  230. c
  231. 12 CONTINUE
  232. IF (ILUMP .EQ. 1) GOTO 99
  233. NBBB=NBNN
  234. IF (MELE.NE.98) LW=IDIM
  235. SEGINI WRK1,WRK3
  236. DO 3012 IB=1,NBELEM
  237. c
  238. c on cherche les coordonnees de l element ib
  239. c
  240. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  241. CALL ZERO(REL,LRE,LRE)
  242. c
  243. c calcul des coefficients de normalisation
  244. c
  245. MPTVAL=IVAMAT
  246. c
  247. IF (MELE.NE.98) THEN
  248. c
  249. DO 5012 IM=1,NMATT
  250. MELVAL=IVAL(IM)
  251. IBMN=MIN(IB,VELCHE(/2))
  252. VALMAT(IM)=VELCHE(1,IBMN)
  253. 5012 CONTINUE
  254. RHOREF=VALMAT(1)
  255. RLCAR = VALMAT(2)
  256. c
  257. CFPI= RHOREF*RLCAR
  258. c
  259. ELSE
  260. c
  261. c cas de l'element litu
  262. c
  263. DO 7012 IM=1,NMATT
  264. MELVAL=IVAL(IM)
  265. IBMN=MIN(IB,VELCHE(/2))
  266. WORK(IM+9)=VELCHE(1,IBMN)
  267. 7012 CONTINUE
  268. ENDIF
  269. c
  270. c lecture des caracteristiques dans work
  271. c
  272. MPTVAL=IVACAR
  273. DO 4012 IC=1,NCARR
  274. IF (IVAL(IC).NE.0) THEN
  275. MELVAL=IVAL(IC)
  276. IBMN=MIN(IB,VELCHE(/2))
  277. WORK(IC)=VELCHE(1,IBMN)
  278. ELSE
  279. WORK(IC)=0.D0
  280. ENDIF
  281. 4012 CONTINUE
  282. c
  283. c cas ou on a lu le mot vecteur
  284. c
  285. IF (IVECT.EQ.1) THEN
  286. IF (IVAL(NCARR).NE.0) THEN
  287. MELVAL=IVAL(NCARR)
  288. IBMN=MIN(IB,IELCHE(/2))
  289. IP=IELCHE(1,IBMN)
  290. IREF=(IP-1)*(IDIM+1)
  291. DO 6112 IC=1,IDIM
  292. WORK(NCARR+IC-1)=XCOOR(IREF+IC)
  293. 6112 CONTINUE
  294. ELSE
  295. DO 6212 IC=1,IDIM
  296. WORK(NCARR+IC-1)=0
  297. 6212 CONTINUE
  298. ENDIF
  299. ENDIF
  300. c
  301. c
  302. c
  303. IF (MELE.EQ.98) THEN
  304. CALL COUMAS(REL,LRE,WORK,XE,KERRE)
  305. ELSE
  306. CALL RACMAS(NBPGAU,IFOUR,NIFOUR,IDIM,NBNN,XE,CFPI,WORK,
  307. 1 POIGAU,SHPTOT,REL,LRE)
  308. ENDIF
  309. c
  310. * SEGINI XMATRI
  311. * IMATTT(IB)=XMATRI
  312. c
  313. c remplissage de xmatri
  314. c
  315. CALL REMPMT(REL,LRE,RE(1,1,ib))
  316. * SEGDES XMATRI
  317. 3012 CONTINUE
  318. SEGDES xMATRI
  319. SEGSUP WRK1,WRK3,MVELCH
  320. GOTO 510
  321. c_______________________________________________________________________
  322. c
  323. c secteur de calcul pour les elements de raccord lia3 lia4
  324. c liquide massif lineaire cas tridimensionnel
  325. c_______________________________________________________________________
  326. c
  327. 18 CONTINUE
  328. IF (ILUMP .EQ. 1) GOTO 99
  329. NBBB=NBNN
  330. LW=IDIM
  331. SEGINI WRK1,WRK3
  332. DO 3018 IB=1,NBELEM
  333. c
  334. c on cherche les coordonnees de l element ib
  335. c
  336. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  337. CALL ZERO(REL,LRE,LRE)
  338. c
  339. c calcul des coefficients de normalisation
  340. c
  341. MPTVAL=IVAMAT
  342. DO 5018 IM=1,NMATT
  343. MELVAL=IVAL(IM)
  344. IBMN=MIN(IB,VELCHE(/2))
  345. VALMAT(IM)=VELCHE(1,IBMN)
  346. 5018 CONTINUE
  347. RHOREF=VALMAT(1)
  348. RLCAR = VALMAT(2)
  349. c
  350. CFPI= RHOREF*RLCAR
  351. c
  352. MPTVAL=IVACAR
  353. DO 4018 IC=1,NCARR
  354. IF (IVAL(IC).NE.0) THEN
  355. MELVAL=IVAL(IC)
  356. IBMN=MIN(IB,VELCHE(/2))
  357. WORK(IC)=VELCHE(1,IBMN)
  358. ELSE
  359. WORK(IC)=0.D0
  360. ENDIF
  361. 4018 CONTINUE
  362. c
  363. CALL LIAMAS(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
  364. 1 SHPTOT,REL,LRE,IER246)
  365. IF(IER246.NE.0) THEN
  366. CALL ERREUR(IER246)
  367. SEGSUP xMATRI
  368. SEGSUP WRK1,WRK3,MVELCH
  369. GOTO 510
  370. ENDIF
  371. * SEGINI XMATRI
  372. * IMATTT(IB)=XMATRI
  373. c
  374. c remplissage de xmatri
  375. c
  376. CALL REMPMT(REL,LRE,RE(1,1,ib))
  377. * SEGDES XMATRI
  378. 3018 CONTINUE
  379. SEGDES xMATRI
  380. SEGSUP WRK1,WRK3,MVELCH
  381. GOTO 510
  382. c_______________________________________________________________________
  383. c
  384. c impedance
  385. c_______________________________________________________________________
  386. c
  387. 45 CONTINUE
  388. IF (jmat.gt.0) THEN
  389. MPTVAL=IVAMAT
  390. MELVAL=IVAL(1)
  391. if (ival(/1).gt.1) then
  392. melva1 = ival(2)
  393. else
  394. melva1 = 0
  395. endif
  396. jddl = LRE/NBPGAU
  397. DO IB = 1,NBELEM
  398. JDIAG = 0
  399. if (melval.gt.0) IBMN=MIN(IB,VELCHE(/2))
  400. do IG = 1, NBPGAU
  401. if (melval.gt.0) igmn = MIN(IG,VELCHE(/1))
  402. XMASS = 0.D0
  403. if (melval.gt.0) XMASS=VELCHE(IGMN,IBMN)
  404. XINER = XMASS
  405. if (melva1.gt.0) then
  406. igmn = MIN(IG,melva1.VELCHE(/1))
  407. XINER = melva1.VELCHE(IGMN,IBMN)
  408. endif
  409. do idl = 1,jddl
  410. JDIAG = JDIAG + 1
  411. RE(JDIAG,JDIAG,ib) = XMASS
  412. if (idim.eq.3.and.idl.gt.3) RE(JDIAG,JDIAG,ib) = XINER
  413. if (idim.ne.3.and.idl.gt.2) RE(JDIAG,JDIAG,ib) = XINER
  414. enddo
  415. * enddo
  416. enddo
  417. ENDDO
  418. SEGDES XMATRI
  419. GOTO 510
  420. ENDIF
  421.  
  422. IF (MFR.EQ.26) THEN
  423. * MODAL (car goto 510 sous IMPEDANCE)
  424. DO IB = 1,NBELEM
  425. * SEGINI XMATRI
  426. * IMATTT(IB)=XMATRI
  427.  
  428. MPTVAL=IVAMAT
  429. MELVAL=IVAL(2)
  430. IBMN=MIN(IB,VELCHE(/2))
  431. XMASS=VELCHE(1,IBMN)
  432. RE(1,1,ib) = XMASS
  433. * SEGDES XMATRI
  434. ENDDO
  435. SEGDES xMATRI
  436. GOTO 510
  437. *
  438. ELSE IF (MFR.EQ.28) THEN
  439. * STATIQUE (car goto 510 sous IMPEDANCE)
  440. DO IB = 1,NBELEM
  441. * SEGINI XMATRI
  442. * IMATTT(IB)=XMATRI
  443.  
  444. MPTVAL=IVAMAT
  445. MELVAL=IVAL(1)
  446. IBMN=MIN(IB,IELCHE(/2))
  447. idepl=IELCHE(1,IBMN)
  448. MELVAL=IVAL(3)
  449. IBMN=MIN(IB,IELCHE(/2))
  450. imade=IELCHE(1,IBMN)
  451. CALL XTY1(idepl,imade,iinc,idua,X1)
  452. re(1,1,ib) = x1
  453. * SEGDES XMATRI
  454. ENDDO
  455. SEGDES xMATRI
  456. GOTO 510
  457. ENDIF
  458. *
  459. c_______________________________________________________________________
  460. c
  461. c element point (poi1) en defos planes generalisees
  462. c_______________________________________________________________________
  463. c
  464. IF(MELE.EQ.45.AND.IFOUR.NE.-3) GOTO 99
  465. NBBB=NBNN
  466. SEGINI WRK1,WRK3
  467. c
  468. c boucle de calcul pour les differents elements
  469. c
  470. DO 3045 IB=1,NBELEM
  471. c
  472. c on cherche les coordonnees de l element ib
  473. c
  474. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  475. c
  476. c on recherche rho et la section
  477. c
  478. MPTVAL=IVAMAT
  479. MELVAL=IVAL(1)
  480. IBMN=MIN(IB,VELCHE(/2))
  481. RR=VELCHE(1,IBMN)
  482. MPTVAL=IVACAR
  483. MELVAL=IVAL(1)
  484. IBMN=MIN(IB,VELCHE(/2))
  485. RR=RR*VELCHE(1,IBMN)
  486. c
  487. c on calcule la matrice de masse
  488. c
  489. CALL PO1MAS(XE,XDPGE,YDPGE,RR,LRE,REL)
  490. c
  491. * SEGINI XMATRI
  492. * IMATTT(IB)=XMATRI
  493. CALL REMPMT(REL,LRE,RE(1,1,ib))
  494. * SEGDES XMATRI
  495. 3045 CONTINUE
  496. SEGDES xMATRI
  497. SEGSUP WRK1,WRK3,MVELCH
  498. GO TO 510
  499. c_______________________________________________________________________
  500. c
  501. c elements barre et cerce
  502. c_______________________________________________________________________
  503. c
  504. 46 CONTINUE
  505. *
  506. IF(MELE.EQ.95.AND.IFOUR.NE.0.AND.IFOUR.NE.1) GOTO 99
  507. *
  508. NBBB=NBNN
  509. SEGINI WRK1,WRK3
  510. IF(MELE.EQ.123) THEN
  511. NCOM=NBNN
  512. LRN =LRE
  513. SEGINI WRK5
  514. ENDIF
  515. c
  516. c boucle de calcul pour les differents elements
  517. c
  518. DO 3046 IB=1,NBELEM
  519. c
  520. c on cherche les coordonnees de l element ib
  521. c
  522. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  523. c
  524. MPTVAL=IVAMAT
  525. MELVAL=IVAL(1)
  526. IBMN=MIN(IB,VELCHE(/2))
  527. RR=VELCHE(1,IBMN)
  528. MPTVAL=IVACAR
  529. MELVAL=IVAL(1)
  530. IBMN=MIN(IB,VELCHE(/2))
  531. RR=RR*VELCHE(1,IBMN)
  532. c
  533. c on calcule la matrice de masse
  534. c
  535. IF(MELE.EQ.46) CALL BARMAS(REL,LRE,RR,XE)
  536. IF(MELE.EQ.95) CALL CERMAS(REL,LRE,RR,XE)
  537. IF(MELE.EQ.123) CALL MASBA3(REL,LRE,RR,XE,XGENE,KERRE)
  538. IF(KERRE.NE.0) INTERR(1)=ISOUS
  539. IF(KERRE.NE.0) INTERR(2)=IB
  540. IF(MELE.EQ.123.AND.KERRE.EQ.1) CALL ERREUR(128)
  541. c
  542. * SEGINI XMATRI
  543. * IMATTT(IB)=XMATRI
  544. IF (ILUMP .EQ. 1) THEN
  545. CALL LUMP1(REL,LRE,RE(1,1,ib),IFOUR)
  546. ELSE
  547. CALL REMPMT(REL,LRE,RE(1,1,ib))
  548. ENDIF
  549. * SEGDES XMATRI
  550. 3046 CONTINUE
  551. SEGDES xMATRI
  552. SEGSUP WRK1,WRK3,MVELCH
  553. IF(MELE.EQ.123) SEGSUP WRK5
  554. GO TO 510
  555. c_______________________________________________________________________
  556. c
  557. c JOINT UNIDIMENSIONNEL JOI1
  558. c_______________________________________________________________________
  559. c
  560. 265 CONTINUE
  561. *
  562. NBBB=NBNN
  563. SEGINI WRK1,WRK3,WRK4
  564. *
  565. DO 3265 IB=1,NBELEM
  566. c
  567. MPTVAL=IVAMAT
  568. DO IC=1,NMATT
  569. IF(IVAL(IC).NE.0) THEN
  570. MELVAL=IVAL(IC)
  571. IBMN=MIN(IB,VELCHE(/2))
  572. WORK(IC)=VELCHE(1,IBMN)
  573. ELSE
  574. WORK(IC)=0.D0
  575. ENDIF
  576. END DO
  577. *
  578. CALL MAPALU(NMATT,WORK,BPSS,IDIM)
  579. c
  580. c on calcule la matrice de masse localement
  581. c
  582. CALL JOIMAS(REL,LRE,WORK,NMATT,IDIM)
  583. c
  584. c on passe en repère global
  585. c
  586. IAW1=101
  587. IAW2=IAW1+LRE*LRE
  588. IAW3=IAW2+LRE*LRE
  589. IAW4=IAW3+LRE*LRE
  590. CALL JOIGLO(REL,BPSS,WORK(IAW1),WORK(IAW2),
  591. & WORK(IAW3),WORK(IAW4),LRE,IDIM)
  592. *
  593. IF (ILUMP .EQ. 1) THEN
  594. CALL LUMP1(REL,LRE,RE(1,1,ib),IFOUR)
  595. ELSE
  596. CALL REMPMT(REL,LRE,RE(1,1,ib))
  597. ENDIF
  598. 3265 CONTINUE
  599. SEGDES xMATRI
  600. SEGSUP WRK1,WRK3,WRK4,MVELCH
  601. GO TO 510
  602. c_______________________________________________________________________
  603. c
  604. c element barre 3d excentre (baex)
  605. c_______________________________________________________________________
  606. c
  607. 124 CONTINUE
  608. NBBB=NBNN
  609. NCOM=2
  610. LRN =LRE
  611. SEGINI WRK1,WRK3,WRK5
  612. c
  613. c boucle de calcul pour les differents elements
  614. c
  615. DO 3199 IB=1,NBELEM
  616. c
  617. c on recupere la section de l'element, ses excentrements et son
  618. c orientation. les caracteristiques sont rangees dans work
  619. c selon l'ordre suivant: sect excz excy vx vy vz
  620. c
  621. MPTVAL=IVACAR
  622. DO IC=1,NCARR
  623. IF(IVAL(IC).NE.0) THEN
  624. MELVAL=IVAL(IC)
  625. IBMN=MIN(IB,VELCHE(/2))
  626. WORK(IC)=VELCHE(1,IBMN)
  627. ELSE
  628. WORK(IC)=0.D0
  629. ENDIF
  630. END DO
  631. SECT=WORK(1)
  632. c
  633. c xgene stocke la matrice de passage de l'element excentre
  634. c
  635. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  636. CALL MAPAEX(XE,NBNN,WORK,AL,XGENE,LRE,KERRE)
  637. IF(KERRE.NE.0) INTERR(1)=ISOUS
  638. IF(KERRE.NE.0) INTERR(2)=IB
  639. IF(KERRE.EQ.1) CALL ERREUR(128)
  640. c
  641. MPTVAL=IVAMAT
  642. MELVAL=IVAL(1)
  643. IBMN=MIN(IB,VELCHE(/2))
  644. RR=VELCHE(1,IBMN)*SECT
  645. c
  646. c on calcule la matrice de masse
  647. c
  648. CALL BAMAEX(REL,LRE,RR,AL,XGENE)
  649. c
  650. * SEGINI XMATRI
  651. * IMATTT(IB)=XMATRI
  652. IF (ILUMP .EQ. 1) THEN
  653. CALL LUMP1(REL,LRE,RE(1,1,ib),IFOUR)
  654. ELSE
  655. CALL REMPMT(REL,LRE,RE(1,1,ib))
  656. ENDIF
  657. * SEGDES XMATRI
  658. 3199 CONTINUE
  659. SEGDES xMATRI
  660. SEGSUP WRK1,WRK3,WRK5,MVELCH
  661. GO TO 510
  662. c_______________________________________________________________________
  663. c
  664. c secteur de calcul pour les elements de raccord
  665. c liquide coque cas bidimensionnel
  666. c_______________________________________________________________________
  667. c
  668. 47 CONTINUE
  669. IF (ILUMP .EQ. 1) GOTO 99
  670. NBBB=NBNN
  671. LW=IDIM
  672. SEGINI WRK1,WRK3
  673. DO 3047 IB=1,NBELEM
  674. c
  675. c on cherche les coordonnees de l element ib
  676. c
  677. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  678. CALL ZERO(REL,LRE,LRE)
  679. c
  680. c calcul des coefficients de normalisation
  681. c
  682. MPTVAL=IVAMAT
  683. DO 5047 IM=1,NMATT
  684. MELVAL=IVAL(IM)
  685. IBMN=MIN(IB,VELCHE(/2))
  686. VALMAT(IM)=VELCHE(1,IBMN)
  687. 5047 CONTINUE
  688. RHOREF=VALMAT(1)
  689. RLCAR = VALMAT(2)
  690. c
  691. CFPI= RHOREF*RLCAR
  692. c
  693. MPTVAL=IVACAR
  694. DO 4047 IC=1,NCARR
  695. IF (IVAL(IC).NE.0) THEN
  696. MELVAL=IVAL(IC)
  697. IBMN=MIN(IB,VELCHE(/2))
  698. WORK(IC)=VELCHE(1,IBMN)
  699. ELSE
  700. WORK(IC)=0.D0
  701. ENDIF
  702. 4047 CONTINUE
  703. c
  704. CALL RACOMA(IFOUR,NIFOUR,IDIM,XE,CFPI,WORK,REL,LRE)
  705. c
  706. * SEGINI XMATRI
  707. * IMATTT(IB)=XMATRI
  708. c
  709. c remplissage de xmatri
  710. c
  711. CALL REMPMT(REL,LRE,RE(1,1,ib))
  712. * SEGDES XMATRI
  713. 3047 CONTINUE
  714. SEGDES xMATRI
  715. SEGSUP WRK3
  716. SEGSUP WRK1,MVELCH
  717. GOTO 510
  718. c_______________________________________________________________________
  719. c
  720. c secteur de calcul pour les elements de raccord
  721. c liquide coque 3 noeuds - cas tridimensionnel
  722. c_______________________________________________________________________
  723. c
  724. 55 CONTINUE
  725. IF (ILUMP .EQ. 1) GOTO 99
  726. NBBB=NBNN
  727. LW=IDIM
  728. SEGINI WRK1,WRK3
  729. DO 3055 IB=1,NBELEM
  730. c
  731. c on cherche les coordonnees de l element ib
  732. c
  733. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  734. CALL ZERO(REL,LRE,LRE)
  735. c
  736. c calcul des coefficients de normalisation
  737. c
  738. MPTVAL=IVAMAT
  739. DO 5055 IM=1,NMATT
  740. MELVAL=IVAL(IM)
  741. IBMN=MIN(IB,VELCHE(/2))
  742. VALMAT(IM)=VELCHE(1,IBMN)
  743. 5055 CONTINUE
  744. RHOREF=VALMAT(1)
  745. RLCAR = VALMAT(2)
  746. c
  747. CFPI= RHOREF*RLCAR
  748. c
  749. MPTVAL=IVACAR
  750. DO 4055 IC=1,NCARR
  751. IF (IVAL(IC).NE.0) THEN
  752. MELVAL=IVAL(IC)
  753. IBMN=MIN(IB,VELCHE(/2))
  754. WORK(IC)=VELCHE(1,IBMN)
  755. ELSE
  756. WORK(IC)=0.D0
  757. ENDIF
  758. 4055 CONTINUE
  759. c
  760. CALL LICOMA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
  761. 1 QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
  762. IF(IER246.NE.0) THEN
  763. CALL ERREUR(IER246)
  764. SEGSUP xMATRI
  765. SEGSUP WRK1,WRK3,MVELCH
  766. GOTO 510
  767. ENDIF
  768. * SEGINI XMATRI
  769. * IMATTT(IB)=XMATRI
  770. c
  771. c remplissage de xmatri
  772. c
  773. CALL REMPMT(REL,LRE,RE(1,1,ib))
  774. * SEGDES XMATRI
  775. 3055 CONTINUE
  776. SEGDES xMATRI
  777. SEGSUP WRK1,WRK3,MVELCH
  778. GOTO 510
  779. c_______________________________________________________________________
  780. c
  781. c secteur de calcul pour les elements joints joi2
  782. c_______________________________________________________________________
  783. c
  784. 85 CONTINUE
  785. IF (ILUMP .EQ. 1) GOTO 99
  786. NBNO=NBNN
  787. NBBB=NBNN
  788. SEGINI WRK1,WRK2,WRK4
  789. I195=0
  790. I259=0
  791. DO 3085 IB=1,NBELEM
  792. c
  793. c on cherche les coordonnees des noeuds de l element ib
  794. c
  795. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  796. CALL ZERO (REL,LRE,LRE)
  797. c
  798. c calcul des coordonnees locales de l'element
  799. c
  800. CALL JO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  801. c
  802. c boucle sur les points de gauss
  803. c
  804. ISDJC=0
  805. DO 4085 IGAU=1,NBPGAU
  806. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  807. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  808. *
  809. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  810. IF(DJAC.EQ.0.) I259=IB
  811. DJAC=ABS(DJAC)*POIGAU(IGAU)
  812. MPTVAL=IVAMAT
  813. IF (IVAL(1).NE.0) THEN
  814. MELVAL=IVAL(1)
  815. IGMN=MIN(IGAU,VELCHE(/1))
  816. IBMN=MIN(IB,VELCHE(/2))
  817. VALMAT(1)=VELCHE(IGMN,IBMN)
  818. ELSE
  819. VALMAT(1)=0.D0
  820. ENDIF
  821. CCCCCCCCCCC DJAC=DJAC*VALMAT(1)/3.0D0
  822. C
  823. C IL FAUT DIVISER PAR 4, CE QUI CORRESPOND PLUS EXACTEMENT A DIVISER
  824. C LE B PAR 2...
  825. C
  826. DJAC=DJAC*VALMAT(1)/4.0D0
  827. c
  828. c cas axisymetrique : multiplication par le rayon de courbure
  829. c
  830. IF (IFOUR.EQ.0) THEN
  831. RAYON = 0.D0
  832. NUMSUP=NBNO/2
  833. DO 4185 IRAY=1,NUMSUP
  834. RAYON=RAYON + ( SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) )
  835. 4185 CONTINUE
  836. DJAC=DJAC*RAYON
  837. ENDIF
  838. c
  839. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  840. 4085 CONTINUE
  841. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  842. * SEGINI XMATRI
  843. * IMATTT(IB)=XMATRI
  844. c
  845. c remplissage de xmatri
  846. c
  847. CALL REMPMT(REL,LRE,RE(1,1,ib))
  848. * SEGDES XMATRI
  849. 3085 CONTINUE
  850. IF(I195.NE.0) INTERR(1)=I195
  851. IF(I195.NE.0) CALL ERREUR(195)
  852. IF(I259.NE.0) INTERR(1)=I259
  853. IF(I259.NE.0) CALL ERREUR(259)
  854. SEGDES xMATRI
  855. SEGSUP WRK1,WRK2,WRK4,MVELCH
  856. GOTO 510
  857. c_______________________________________________________________________
  858. c
  859. c secteur de calcul pour les elements joints jot3
  860. c_______________________________________________________________________
  861. c
  862. 87 CONTINUE
  863. IF (ILUMP .EQ. 1) GOTO 99
  864. NBNO=NBNN
  865. NBBB=NBNN
  866. SEGINI WRK1,WRK2,WRK4
  867. I195=0
  868. I259=0
  869. DO 3087 IB=1,NBELEM
  870. c
  871. c on cherche les coordonnees des noeuds de l element ib
  872. c
  873. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  874. CALL ZERO (REL,LRE,LRE)
  875. c
  876. c calcul des coordonnees locales de l'element
  877. c
  878. CALL JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  879. c
  880. c boucle sur les points de gauss
  881. c
  882. ISDJC=0
  883. DO 4087 IGAU=1,NBPGAU
  884. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  885. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  886. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  887. IF(DJAC.EQ.0.) I259=IB
  888. DJAC=ABS(DJAC)*POIGAU(IGAU)
  889. MPTVAL=IVAMAT
  890. IF (IVAL(1).NE.0) THEN
  891. MELVAL=IVAL(1)
  892. IGMN=MIN(IGAU,VELCHE(/1))
  893. IBMN=MIN(IB,VELCHE(/2))
  894. VALMAT(1)=VELCHE(IGMN,IBMN)
  895. ELSE
  896. VALMAT(1)=0.D0
  897. ENDIF
  898. DJAC=DJAC*VALMAT(1)
  899. CCCCCCCCCCC DJAC=DJAC/3.0D0
  900. C IL FAUT DIVISER PAR 4, CE QUI CORRESPOND PLUS EXACTEMENT A DIVISER
  901. C LE B PAR 2...
  902. DJAC=DJAC/4.0D0
  903. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  904. 4087 CONTINUE
  905. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  906. * SEGINI XMATRI
  907. * IMATTT(IB)=XMATRI
  908. c
  909. c remplissage de xmatri
  910. c
  911. CALL REMPMT(REL,LRE,RE(1,1,ib))
  912. * SEGDES XMATRI
  913. 3087 CONTINUE
  914. IF(I195.NE.0) INTERR(1)=I195
  915. IF(I195.NE.0) CALL ERREUR(195)
  916. IF(I259.NE.0) INTERR(1)=I259
  917. IF(I259.NE.0) CALL ERREUR(259)
  918. SEGDES xMATRI
  919. SEGSUP WRK1,WRK2,WRK4,MVELCH
  920. GOTO 510
  921. c_______________________________________________________________________
  922. c
  923. c secteur de calcul pour les elements joints joi4
  924. c_______________________________________________________________________
  925. c
  926. 88 CONTINUE
  927. IF (ILUMP .EQ. 1) GOTO 99
  928. NBNO=NBNN
  929. NBBB=NBNN
  930. SEGINI WRK1,WRK2,WRK4
  931. I195=0
  932. I259=0
  933. DO 3088 IB=1,NBELEM
  934. c
  935. c on cherche les coordonnees des noeuds de l element ib
  936. c
  937. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  938. CALL ZERO (REL,LRE,LRE)
  939. c
  940. c calcul des coordonnees locales de l'element
  941. c
  942. CALL JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  943. c
  944. c boucle sur les points de gauss
  945. c
  946. ISDJC=0
  947. DO 4088 IGAU=1,NBPGAU
  948. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  949. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  950. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  951. IF(DJAC.EQ.0.) I259=IB
  952. DJAC=ABS(DJAC)*POIGAU(IGAU)
  953. MPTVAL=IVAMAT
  954. IF (IVAL(1).NE.0) THEN
  955. MELVAL=IVAL(1)
  956. IGMN=MIN(IGAU,VELCHE(/1))
  957. IBMN=MIN(IB,VELCHE(/2))
  958. VALMAT(1)=VELCHE(IGMN,IBMN)
  959. ELSE
  960. VALMAT(1)=0.D0
  961. ENDIF
  962. DJAC=DJAC*VALMAT(1)
  963. CCCCCCCCCCCC DJAC=DJAC/3.0D0
  964. C IL FAUT DIVISER PAR 4, CE QUI CORRESPOND PLUS EXACTEMENT A DIVISER
  965. C LE B PAR 2...
  966. DJAC=DJAC/4.0D0
  967. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  968. 4088 CONTINUE
  969. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  970. * SEGINI XMATRI
  971. * IMATTT(IB)=XMATRI
  972. c
  973. c remplissage de xmatri
  974. c
  975. CALL REMPMT(REL,LRE,RE(1,1,ib))
  976. * SEGDES XMATRI
  977. 3088 CONTINUE
  978. IF(I195.NE.0) INTERR(1)=I195
  979. IF(I195.NE.0) CALL ERREUR(195)
  980. IF(I259.NE.0) INTERR(1)=I259
  981. IF(I259.NE.0) CALL ERREUR(259)
  982. SEGDES xMATRI
  983. SEGSUP WRK1,WRK2,WRK4,MVELCH
  984. GOTO 510
  985. c_______________________________________________________________________
  986. c
  987. c secteur de calcul pour les elements joints jgi2
  988. c_______________________________________________________________________
  989. c
  990. 170 CONTINUE
  991. IF (IFOUR.EQ.-3) NDDL=NDDL+1
  992. IF (ILUMP .EQ. 1) GOTO 99
  993. NBNO=NBNN
  994. NBBB=NBNN
  995. SEGINI WRK1,WRK2,WRK4
  996. I195=0
  997. I259=0
  998. C
  999. IG1=0
  1000. C
  1001. DO IB=1,NBELEM
  1002. c
  1003. c on cherche les coordonnees des noeuds de l element ib
  1004. c
  1005. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1006. CALL ZERO (REL,LRE,LRE)
  1007. c
  1008. c calcul des coordonnees locales de l'element
  1009. c
  1010. CALL JO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1011. c
  1012. c boucle sur les points de gauss
  1013. c
  1014. ISDJC=0
  1015. DO IGAU=1,NBPGAU
  1016. MPTVAL=IVAMAT
  1017. DO IM=1,NMATT
  1018. MELVAL=IVAL(IM)
  1019. IGMN=MIN(IGAU,VELCHE(/1))
  1020. IBMN=MIN(IB,VELCHE(/2))
  1021. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1022. ENDDO
  1023. C
  1024. EPAIST=VALMAT(2)
  1025. IF(EPAIST.EQ.0.D0)THEN
  1026. CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,
  1027. . SHPWRK,EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT)
  1028. IF(IERT.NE.0) IG1=IB
  1029. ENDIF
  1030. C
  1031. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1032. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1033. *
  1034. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1035. IF(DJAC.EQ.0.) I259=IB
  1036. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1037. *
  1038. c valmat(1)=rho, valmat(2)=epai
  1039. c /4 correspnnd en fait a diviser les matrices B par 2
  1040. CCCCCCCCCCCC DJAC=DJAC*VALMAT(1)*VALMAT(2)/4.0D0
  1041. DJAC=DJAC*VALMAT(1)*EPAIST/4.0D0
  1042. c
  1043. c cas axisymetrique : multiplication par le rayon de courbure
  1044. c
  1045. IF (IFOUR.EQ.0) THEN
  1046. RAYON = 0.D0
  1047. NUMSUP=NBNO/2
  1048. DO IRAY=1,NUMSUP
  1049. RAYON=RAYON + ( SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) )
  1050. ENDDO
  1051. DJAC=DJAC*RAYON
  1052. ENDIF
  1053. c
  1054. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1055. ENDDO
  1056. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1057. * SEGINI XMATRI
  1058. * IMATTT(IB)=XMATRI
  1059. c
  1060. c remplissage de xmatri
  1061. c
  1062. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1063. * SEGDES XMATRI
  1064. ENDDO
  1065. C
  1066. IF(IG1.NE.0) INTERR(1)=IG1
  1067. IF(IG1.NE.0) CALL ERREUR (611)
  1068. C
  1069. IF(I195.NE.0) INTERR(1)=I195
  1070. IF(I195.NE.0) CALL ERREUR(195)
  1071. IF(I259.NE.0) INTERR(1)=I259
  1072. IF(I259.NE.0) CALL ERREUR(259)
  1073. SEGDES xMATRI
  1074. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1075. GOTO 510
  1076. C
  1077. c_______________________________________________________________________
  1078. c
  1079. c secteur de calcul pour les elements joints jct3 en 2D cisaillement
  1080. c_______________________________________________________________________
  1081. c
  1082. 168 CONTINUE
  1083. IF (ILUMP .EQ. 1) GOTO 99
  1084. NBNO=NBNN
  1085. NBBB=NBNN
  1086. SEGINI WRK1,WRK2,WRK4
  1087. I195=0
  1088. I259=0
  1089. DO IB=1,NBELEM
  1090. c
  1091. c on cherche les coordonnees des noeuds de l element ib
  1092. c
  1093. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1094. CALL ZERO (REL,LRE,LRE)
  1095. c
  1096. c calcul des coordonnees locales de l'element
  1097. c
  1098. CALL JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1099. c
  1100. c boucle sur les points de gauss
  1101. c
  1102. ISDJC=0
  1103. DO IGAU=1,NBPGAU
  1104. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1105. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1106. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1107. IF(DJAC.EQ.0.) I259=IB
  1108. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1109. MPTVAL=IVAMAT
  1110. IF (IVAL(1).NE.0) THEN
  1111. MELVAL=IVAL(1)
  1112. IGMN=MIN(IGAU,VELCHE(/1))
  1113. IBMN=MIN(IB,VELCHE(/2))
  1114. VALMAT(1)=VELCHE(IGMN,IBMN)
  1115. ELSE
  1116. VALMAT(1)=0.D0
  1117. ENDIF
  1118. DJAC=DJAC*VALMAT(1)
  1119. CCCCCCCCCC DJAC=DJAC/3.0D0
  1120. C Il faut diviser par 4, ce qui correspond plus exactement a diviser
  1121. C le B par 2...
  1122. DJAC=DJAC/4.0D0
  1123. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1124. ENDDO
  1125. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1126. * SEGINI XMATRI
  1127. * IMATTT(IB)=XMATRI
  1128. c
  1129. c remplissage de xmatri
  1130. c
  1131. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1132. SEGDES XMATRI
  1133. ENDDO
  1134. IF(I195.NE.0) INTERR(1)=I195
  1135. IF(I195.NE.0) CALL ERREUR(195)
  1136. IF(I259.NE.0) INTERR(1)=I259
  1137. IF(I259.NE.0) CALL ERREUR(259)
  1138. SEGDES xMATRI
  1139. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1140. GOTO 510
  1141. c_______________________________________________________________________
  1142. c
  1143. c secteur de calcul pour les elements joints jgt3 generalise
  1144. c_______________________________________________________________________
  1145. c
  1146. 171 CONTINUE
  1147. IF (ILUMP .EQ. 1) GOTO 99
  1148. NBNO=NBNN
  1149. NBBB=NBNN
  1150. SEGINI WRK1,WRK2,WRK4
  1151. I195=0
  1152. I259=0
  1153. C
  1154. IG1=0
  1155. C
  1156. DO IB=1,NBELEM
  1157. c
  1158. c on cherche les coordonnees des noeuds de l element ib
  1159. c
  1160. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1161. CALL ZERO (REL,LRE,LRE)
  1162. c
  1163. c calcul des coordonnees locales de l'element
  1164. c
  1165. CALL JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1166. c
  1167. c boucle sur les points de gauss
  1168. c
  1169. ISDJC=0
  1170. DO IGAU=1,NBPGAU
  1171. MPTVAL=IVAMAT
  1172. DO IM=1,NMATT
  1173. MELVAL=IVAL(IM)
  1174. IGMN=MIN(IGAU,VELCHE(/1))
  1175. IBMN=MIN(IB,VELCHE(/2))
  1176. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1177. ENDDO
  1178. C
  1179. EPAIST=VALMAT(2)
  1180. IF(EPAIST.EQ.0.D0)THEN
  1181. CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,
  1182. . SHPWRK,EPAIST,BGENE,DJAC,IERT)
  1183. IF(IERT.NE.0) IG1=IB
  1184. ENDIF
  1185. C
  1186. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1187. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1188. *
  1189. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1190. IF(DJAC.EQ.0.) I259=IB
  1191. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1192. *
  1193. c valmat(1)=rho, valmat(2)=epai
  1194. c /4 correspnnd en fait a diviser les matrices B par 2
  1195. CCCCCCCCCCCC DJAC=DJAC*VALMAT(1)*VALMAT(2)/4.0D0
  1196. DJAC=DJAC*VALMAT(1)*EPAIST/4.0D0
  1197. *
  1198. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1199. ENDDO
  1200. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1201. * SEGINI XMATRI
  1202. * IMATTT(IB)=XMATRI
  1203. c
  1204. c remplissage de xmatri
  1205. c
  1206. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1207. * SEGDES XMATRI
  1208. ENDDO
  1209. C
  1210. IF(IG1.NE.0) INTERR(1)=IG1
  1211. IF(IG1.NE.0) CALL ERREUR (611)
  1212. C
  1213. IF(I195.NE.0) INTERR(1)=I195
  1214. IF(I195.NE.0) CALL ERREUR(195)
  1215. IF(I259.NE.0) INTERR(1)=I259
  1216. IF(I259.NE.0) CALL ERREUR(259)
  1217. SEGDES xMATRI
  1218. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1219. GOTO 510
  1220. C
  1221. c_______________________________________________________________________
  1222. c
  1223. c secteur de calcul pour les elements joints jci4 en 2D cisaillement
  1224. c_______________________________________________________________________
  1225. c
  1226. 169 CONTINUE
  1227. IF (ILUMP .EQ. 1) GOTO 99
  1228. NBNO=NBNN
  1229. NBBB=NBNN
  1230. SEGINI WRK1,WRK2,WRK4
  1231. I195=0
  1232. I259=0
  1233. DO IB=1,NBELEM
  1234. c
  1235. c on cherche les coordonnees des noeuds de l element ib
  1236. c
  1237. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1238. CALL ZERO (REL,LRE,LRE)
  1239. c
  1240. c calcul des coordonnees locales de l'element
  1241. c
  1242. CALL JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1243. c
  1244. c boucle sur les points de gauss
  1245. c
  1246. ISDJC=0
  1247. DO IGAU=1,NBPGAU
  1248. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1249. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1250. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1251. IF(DJAC.EQ.0.) I259=IB
  1252. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1253. MPTVAL=IVAMAT
  1254. IF (IVAL(1).NE.0) THEN
  1255. MELVAL=IVAL(1)
  1256. IGMN=MIN(IGAU,VELCHE(/1))
  1257. IBMN=MIN(IB,VELCHE(/2))
  1258. VALMAT(1)=VELCHE(IGMN,IBMN)
  1259. ELSE
  1260. VALMAT(1)=0.D0
  1261. ENDIF
  1262. DJAC=DJAC*VALMAT(1)
  1263. CCCCCCCCCCC DJAC=DJAC/3.0D0
  1264. C Il faut diviser par 4, ce qui correspond plus exactement a diviser
  1265. C le B par 2...
  1266. DJAC=DJAC/4.0D0
  1267. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1268. ENDDO
  1269. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1270. * SEGINI XMATRI
  1271. * IMATTT(IB)=XMATRI
  1272. c
  1273. c remplissage de xmatri
  1274. c
  1275. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1276. * SEGDES XMATRI
  1277. ENDDO
  1278. IF(I195.NE.0) INTERR(1)=I195
  1279. IF(I195.NE.0) CALL ERREUR(195)
  1280. IF(I259.NE.0) INTERR(1)=I259
  1281. IF(I259.NE.0) CALL ERREUR(259)
  1282. SEGDES xMATRI
  1283. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1284. GOTO 510
  1285. c_______________________________________________________________________
  1286. c
  1287. c secteur de calcul pour les elements joints jgi4 generalise
  1288. c_______________________________________________________________________
  1289. c
  1290. 172 CONTINUE
  1291. IF (ILUMP .EQ. 1) GOTO 99
  1292. NBNO=NBNN
  1293. NBBB=NBNN
  1294. SEGINI WRK1,WRK2,WRK4
  1295. I195=0
  1296. I259=0
  1297. C
  1298. IG1=0
  1299. C
  1300. DO IB=1,NBELEM
  1301. c
  1302. c on cherche les coordonnees des noeuds de l element ib
  1303. c
  1304. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1305. CALL ZERO (REL,LRE,LRE)
  1306. c
  1307. c calcul des coordonnees locales de l'element
  1308. c
  1309. CALL JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1310. c
  1311. c boucle sur les points de gauss
  1312. c
  1313. ISDJC=0
  1314. DO IGAU=1,NBPGAU
  1315. MPTVAL=IVAMAT
  1316. DO IM=1,NMATT
  1317. MELVAL=IVAL(IM)
  1318. IGMN=MIN(IGAU,VELCHE(/1))
  1319. IBMN=MIN(IB,VELCHE(/2))
  1320. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1321. ENDDO
  1322. C
  1323. EPAIST=VALMAT(2)
  1324. IF(EPAIST.EQ.0.D0)THEN
  1325. CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,
  1326. . BGENE,DJAC,IERT)
  1327. IF(IERT.NE.0) IG1=IB
  1328. ENDIF
  1329. C
  1330. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1331. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1332. *
  1333. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1334. IF(DJAC.EQ.0.) I259=IB
  1335. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1336. *
  1337. c valmat(1)=rho, valmat(2)=epai
  1338. c /4 correspnnd en fait a diviser les matrices B par 2
  1339. CCCCCCCCCCCC DJAC=DJAC*VALMAT(1)*VALMAT(2)/4.0D0
  1340. DJAC=DJAC*VALMAT(1)*EPAIST/4.0D0
  1341. *
  1342. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1343. ENDDO
  1344. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1345. * SEGINI XMATRI
  1346. * IMATTT(IB)=XMATRI
  1347. c
  1348. c remplissage de xmatri
  1349. c
  1350. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1351. * SEGDES XMATRI
  1352. ENDDO
  1353. C
  1354. IF(IG1.NE.0) INTERR(1)=IG1
  1355. IF(IG1.NE.0) CALL ERREUR (611)
  1356. C
  1357. IF(I195.NE.0) INTERR(1)=I195
  1358. IF(I195.NE.0) CALL ERREUR(195)
  1359. IF(I259.NE.0) INTERR(1)=I259
  1360. IF(I259.NE.0) CALL ERREUR(259)
  1361. SEGDES xMATRI
  1362. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1363. GOTO 510
  1364. C
  1365. c_______________________________________________________________________
  1366. c
  1367. c secteur de calcul pour les elements homogeneises
  1368. c (liquide solide) trih
  1369. c_______________________________________________________________________
  1370. c
  1371. 92 CONTINUE
  1372. IF (ILUMP .EQ. 1) GOTO 99
  1373. NBNO=NBNN
  1374. NBBB=NBNN
  1375. SEGINI WRK1,WRK2
  1376. I195=0
  1377. DO 3092 IB=1,NBELEM
  1378. c
  1379. c on cherche les coordonnees des noeuds de l element ib
  1380. c
  1381. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1382. CALL ZERO (REL,LRE,LRE)
  1383. c
  1384. c on cherche les caracteristiques du materiau de l element ib
  1385. c
  1386. MPTVAL=IVAMAT
  1387. DO 8092 IM=1,NMATT
  1388. MELVAL=IVAL(IM)
  1389. IBMN=MIN(IB,VELCHE(/2))
  1390. VALMAT(IM)=VELCHE(1,IBMN)
  1391. 8092 CONTINUE
  1392. B11 =VALMAT(1)
  1393. B22 =VALMAT(2)
  1394. B12 =VALMAT(3)
  1395. RHOF =VALMAT(4)
  1396. RHOS =VALMAT(5)
  1397. C =VALMAT(6)
  1398. RHOREF=VALMAT(7)
  1399. CREF =VALMAT(8)
  1400. RLCAR =VALMAT(9)
  1401. c
  1402. c on cherche les caracteristiques geometriques de l element ib
  1403. c
  1404. MPTVAL=IVACAR
  1405. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  1406. MELVAL=IVAL(1)
  1407. IBMN=MIN(IB,VELCHE(/2))
  1408. SECT=VELCHE(1,IBMN)
  1409. MELVAL=IVAL(2)
  1410. IBMN=MIN(IB,VELCHE(/2))
  1411. SCEL=VELCHE(1,IBMN)
  1412. MELVAL=IVAL(3)
  1413. IBMN=MIN(IB,VELCHE(/2))
  1414. SFLU=VELCHE(1,IBMN)
  1415. MELVAL=IVAL(4)
  1416. IBMN=MIN(IB,VELCHE(/2))
  1417. EPS =VELCHE(1,IBMN)
  1418. ELSE
  1419. SECT=1.D0
  1420. MELVAL=IVAL(1)
  1421. IBMN=MIN(IB,VELCHE(/2))
  1422. SCEL=VELCHE(1,IBMN)
  1423. MELVAL=IVAL(2)
  1424. IBMN=MIN(IB,VELCHE(/2))
  1425. SFLU=VELCHE(1,IBMN)
  1426. MELVAL=IVAL(3)
  1427. IBMN=MIN(IB,VELCHE(/2))
  1428. EPS =VELCHE(1,IBMN)
  1429. MELVAL=IVAL(4)
  1430. IBMN=MIN(IB,VELCHE(/2))
  1431. F11 =VELCHE(1,IBMN)
  1432. MELVAL=IVAL(5)
  1433. IBMN=MIN(IB,VELCHE(/2))
  1434. F12 =VELCHE(1,IBMN)
  1435. ENDIF
  1436. c
  1437. c calcul de la masse m0/eps**2
  1438. c
  1439. RHOSS=RHOS*SECT/(EPS*EPS)
  1440. c
  1441. c calcul des coefficients de normalisation
  1442. c
  1443. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1444. COEFPI=RHOREF*RLCAR
  1445. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1446. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1447. VKL23 = COEFPI/SCEL
  1448. VKL33 = 1.D0/SCEL
  1449. IF(IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  1450. VKL23 =COEFPI*0.5D0*(2.D0*SCEL-B11-B22)/SCEL
  1451. VKL33 =(RHOSS+RHOF*(SFLU-(B11+B22)/2.D0))/SCEL
  1452. c
  1453. c calcul des termes en pi*pi
  1454. c integration par nbpgau points de gauss
  1455. c
  1456. ISDJC=0
  1457. DO 4092 IGAU=1,NBPGAU
  1458. POIGA2=MINTE.POIGAU(IGAU)
  1459. CALL TRIHM1(IGAU,MELE,MFR,NBNO,XE,SHPTOT,SHPWRK,
  1460. # IFOUR,NHRM,B11,B22,SFLU,POIGA2,VKL22,LRE,REL,IRRT)
  1461. IF(IRRT.NE.1) GOTO 7092
  1462. c
  1463. c calcul du reste des termes de la matrice masse
  1464. c integration par nbpgau points de gauss
  1465. c
  1466. CALL TRIHM2(IGAU,MELE,MFR,NBNO,XE,MINTE.SHPTOT,SHPWRK
  1467. # ,IFOUR,NHRM,VKL12,VKL23,VKL33,POIGA2,ISDJC,LRE,REL,IRRT)
  1468. IF(IRRT.NE.1) GOTO 7092
  1469. 4092 CONTINUE
  1470. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1471. ELSE
  1472. c
  1473. c boucle sur les points de gauss
  1474. c cas plan
  1475. c
  1476. ISDJC=0
  1477. DO 6092 IGAU1=1,NBPGAU
  1478. POIGA1=MINTE.POIGAU(IGAU1)
  1479. CALL TRIHM3(IGAU1,MELE,NBNO,XE,SHPTOT,SHPWRK
  1480. # ,RHOSS,RHOF,
  1481. # B11,B22,B12,F11,F12,SFLU,SCEL,POIGA1,VKL12,VKL22,
  1482. # VKL23,VKL33,LRE,REL,ISDJC,IRRT)
  1483. IF(IRRT.NE.1) GOTO 7092
  1484. 6092 CONTINUE
  1485. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1486. ENDIF
  1487. * SEGINI XMATRI
  1488. * IMATTT(IB)=XMATRI
  1489. c
  1490. c remplissage de xmatri
  1491. c
  1492. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1493. * SEGDES XMATRI
  1494. 3092 CONTINUE
  1495. c
  1496. c impression d un eventuel message d erreur
  1497. c
  1498. IF(I195.NE.0) INTERR(1)=I195
  1499. IF(I195.NE.0) CALL ERREUR(195)
  1500. 7092 CONTINUE
  1501. IF(IRRT.EQ.0) THEN
  1502. MOTERR(1:4)=NOMTP(MELE)
  1503. CALL ERREUR(420)
  1504. ELSE
  1505. IF(IRRT.EQ.2) THEN
  1506. INTERR(1) = IB
  1507. CALL ERREUR(405)
  1508. ENDIF
  1509. ENDIF
  1510. IF(IRRT.EQ.3) CALL ERREUR(421)
  1511. IF(IRRT.EQ.4) CALL ERREUR(422)
  1512. SEGDES xMATRI
  1513. SEGSUP WRK1,WRK2,MVELCH
  1514. GOTO 510
  1515. c_______________________________________________________________________
  1516. c
  1517. c secteur de calcul pour les elements de raccord
  1518. c liquide coque 4 noeuds - cas tridimensionnel
  1519. c_______________________________________________________________________
  1520. c
  1521. 94 CONTINUE
  1522. IF (ILUMP .EQ. 1) GOTO 99
  1523. NBBB=NBNN
  1524. LW=IDIM
  1525. SEGINI WRK1,WRK3
  1526. DO 3094 IB=1,NBELEM
  1527. c
  1528. c on cherche les coordonnees de l element ib
  1529. c
  1530. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1531. CALL ZERO(REL,LRE,LRE)
  1532. c
  1533. c calcul des coefficients de normalisation
  1534. c
  1535. MPTVAL=IVAMAT
  1536. DO 5094 IM=1,NMATT
  1537. MELVAL=IVAL(IM)
  1538. IBMN=MIN(IB,VELCHE(/2))
  1539. VALMAT(IM)=VELCHE(1,IBMN)
  1540. 5094 CONTINUE
  1541. RHOREF=VALMAT(1)
  1542. RLCAR = VALMAT(2)
  1543. c
  1544. CFPI= RHOREF*RLCAR
  1545. c
  1546. MPTVAL=IVACAR
  1547. DO 4094 IC=1,NCARR
  1548. IF (IVAL(IC).NE.0) THEN
  1549. MELVAL=IVAL(IC)
  1550. IBMN=MIN(IB,VELCHE(/2))
  1551. WORK(IC)=VELCHE(1,IBMN)
  1552. ELSE
  1553. WORK(IC)=0.D0
  1554. ENDIF
  1555. 4094 CONTINUE
  1556. c
  1557. CALL LIC4MA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
  1558. 1 QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
  1559. IF(IER246.NE.0) THEN
  1560. CALL ERREUR(IER246)
  1561. SEGSUP xMATRI
  1562. SEGSUP WRK1,WRK3,MVELCH
  1563. GOTO 510
  1564. ENDIF
  1565. * SEGINI XMATRI
  1566. * IMATTT(IB)=XMATRI
  1567. c
  1568. c remplissage de xmatri
  1569. c
  1570. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1571. * SEGDES XMATRI
  1572. 3094 CONTINUE
  1573. SEGDES xMATRI
  1574. SEGSUP WRK1,WRK3,MVELCH
  1575. GOTO 510
  1576. c_______________________________________________________________________
  1577. c
  1578. c secteur de calcul pour les elements homogeneises
  1579. c (liquide solide) quah
  1580. c_______________________________________________________________________
  1581. c
  1582. 126 CONTINUE
  1583. c
  1584. IF (ILUMP .EQ. 1) GOTO 99
  1585. NBNO=NBNN
  1586. NBBB=NBNN
  1587. SEGINI WRK1,WRK2
  1588. I195=0
  1589. DO 3126 IB=1,NBELEM
  1590. c
  1591. c on cherche les coordonnees des noeuds de l element ib
  1592. c
  1593. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1594. CALL ZERO (REL,LRE,LRE)
  1595. c
  1596. c on cherche les caracteristiques du materiau de l element ib
  1597. c
  1598. MPTVAL=IVAMAT
  1599. DO 8126 IM=1,NMATT
  1600. MELVAL=IVAL(IM)
  1601. IBMN=MIN(IB,VELCHE(/2))
  1602. VALMAT(IM)=VELCHE(1,IBMN)
  1603. 8126 CONTINUE
  1604. B11 =VALMAT(1)
  1605. B22 =VALMAT(2)
  1606. B12 =VALMAT(3)
  1607. RHOF =VALMAT(4)
  1608. RHOS =VALMAT(5)
  1609. C =VALMAT(6)
  1610. RHOREF=VALMAT(7)
  1611. CREF =VALMAT(8)
  1612. RLCAR =VALMAT(9)
  1613. c
  1614. c on cherche les caracteristiques geometriques de l element ib
  1615. c
  1616. MPTVAL=IVACAR
  1617. MELVAL=IVAL(4)
  1618. IBMN=MIN(IB,VELCHE(/2))
  1619. SECT=VELCHE(1,IBMN)
  1620. c
  1621. MELVAL=IVAL(1)
  1622. IBMN=MIN(IB,VELCHE(/2))
  1623. SCEL=VELCHE(1,IBMN)
  1624. c
  1625. MELVAL=IVAL(2)
  1626. IBMN=MIN(IB,VELCHE(/2))
  1627. SFLU=VELCHE(1,IBMN)
  1628. c
  1629. MELVAL=IVAL(3)
  1630. IBMN=MIN(IB,VELCHE(/2))
  1631. EPS =VELCHE(1,IBMN)
  1632. c
  1633. c
  1634. c calcul de la masse m0/eps**2
  1635. c
  1636. RHOSS=RHOS*SECT/(EPS*EPS)
  1637. c
  1638. c calcul des coefficients de normalisation
  1639. c
  1640. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1641. COEFPI=RHOREF*RLCAR
  1642. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1643. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1644. VKL23 =COEFPI*0.5D0*(2.D0*SCEL-B11-B22)/SCEL
  1645. VKL33 =(RHOSS+RHOF*(SFLU-(B11+B22)/2.D0))/SCEL
  1646. c
  1647. c
  1648. c calcul des termes en pi*pi
  1649. c integration par nbpgau points de gauss
  1650. c
  1651. ISDJC=0
  1652. DO 4126 IGAU=1,NBPGAU
  1653. POIGA2=MINTE.POIGAU(IGAU)
  1654. CALL QUAHM1(IGAU,MELE,MFR,NBNO,XE,SHPTOT,SHPWRK,IFOUR
  1655. # ,NHRM,B11,B22,SFLU,POIGA2,VKL22,LRE,REL,IRRT)
  1656. IF(IRRT.NE.1) GOTO 7126
  1657. c
  1658. c calcul du reste des termes de la matrice masse
  1659. c integration par nbpgau points de gauss
  1660. c
  1661. CALL QUAHM2(IGAU,MELE,MFR,NBNO,XE,MINTE.SHPTOT,SHPWRK
  1662. # ,IFOUR,NHRM,VKL12,VKL23,VKL33,POIGA2,ISDJC,LRE,REL,IRRT)
  1663. IF(IRRT.NE.1) GOTO 7126
  1664. 4126 CONTINUE
  1665. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1666. c
  1667. * SEGINI XMATRI
  1668. * IMATTT(IB)=XMATRI
  1669. c
  1670. c remplissage de xmatri
  1671. c
  1672. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1673. * SEGDES XMATRI
  1674. 3126 CONTINUE
  1675. c
  1676. c impression d un eventuel message d erreur
  1677. c
  1678. IF(I195.NE.0) INTERR(1)=I195
  1679. IF(I195.NE.0) CALL ERREUR(195)
  1680. 7126 CONTINUE
  1681. IF(IRRT.EQ.0) THEN
  1682. MOTERR(1:4)=NOMTP(MELE)
  1683. CALL ERREUR(420)
  1684. ELSE
  1685. IF(IRRT.EQ.2) THEN
  1686. INTERR(1) = IB
  1687. CALL ERREUR(405)
  1688. ENDIF
  1689. ENDIF
  1690. IF(IRRT.EQ.3) CALL ERREUR(421)
  1691. IF(IRRT.EQ.4) CALL ERREUR(422)
  1692. SEGDES xMATRI
  1693. SEGSUP WRK1,WRK2,MVELCH
  1694. GOTO 510
  1695. c
  1696. c_______________________________________________________________________
  1697. c
  1698. c secteur de calcul pour les elements homogeneises
  1699. c (liquide solide) cubh
  1700. c_______________________________________________________________________
  1701. c
  1702. 127 CONTINUE
  1703. IF (ILUMP .EQ. 1) GOTO 99
  1704. NBNO=NBNN
  1705. NBBB=NBNN
  1706. LW=IDIM
  1707. SEGINI WRK1,WRK2
  1708. I195=0
  1709. DO 3127 IB=1,NBELEM
  1710. c
  1711. c on cherche les coordonnees des noeuds de l element ib
  1712. c
  1713. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1714. CALL ZERO (REL,LRE,LRE)
  1715. c
  1716. c on cherche les caracteristiques du materiau de l element ib
  1717. c
  1718. MPTVAL=IVAMAT
  1719. DO 8127 IM=1,NMATT
  1720. MELVAL=IVAL(IM)
  1721. IBMN=MIN(IB,VELCHE(/2))
  1722. VALMAT(IM)=VELCHE(1,IBMN)
  1723. 8127 CONTINUE
  1724. B11 =VALMAT(1)
  1725. B22 =VALMAT(2)
  1726. B12 =VALMAT(3)
  1727. RHOF =VALMAT(4)
  1728. RHOS =VALMAT(5)
  1729. C =VALMAT(6)
  1730. RHOREF=VALMAT(7)
  1731. CREF =VALMAT(8)
  1732. RLCAR =VALMAT(9)
  1733. c
  1734. c on cherche les caracteristiques geometriques de l element ib
  1735. c
  1736. MPTVAL=IVACAR
  1737. c
  1738. MELVAL=IVAL(1)
  1739. IBMN=MIN(IB,VELCHE(/2))
  1740. SCEL=VELCHE(1,IBMN)
  1741. c
  1742. MELVAL=IVAL(2)
  1743. IBMN=MIN(IB,VELCHE(/2))
  1744. SFLU=VELCHE(1,IBMN)
  1745. c
  1746. MELVAL=IVAL(3)
  1747. IBMN=MIN(IB,VELCHE(/2))
  1748. EPS =VELCHE(1,IBMN)
  1749. c
  1750. MELVAL=IVAL(4)
  1751. IBMN=MIN(IB,VELCHE(/2))
  1752. SECT =VELCHE(1,IBMN)
  1753. c
  1754. c calcul de la masse m0/eps**2
  1755. c
  1756. RHOSS=RHOS*SECT/(EPS*EPS)
  1757. c
  1758. c calcul des coefficients de normalisation
  1759. c
  1760. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1761. COEFPI=RHOREF*RLCAR
  1762. c
  1763. c
  1764. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1765. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1766. c
  1767. VKL23 = COEFPI/SCEL
  1768. VKL33 = 1.D0/SCEL
  1769. c
  1770. ISDJC=0
  1771. DO 6127 IGAU1=1,NBPGAU
  1772. POIGA1=MINTE.POIGAU(IGAU1)
  1773. CALL CUBHM1(IGAU1,MELE,NBNO,XE,SHPTOT,SHPWRK,
  1774. # RHOSS,RHOF,B11,B22,B12,SFLU,SCEL,POIGA1,VKL12,VKL22,VKL23,
  1775. # VKL33,LRE,REL,ISDJC,IRRT)
  1776. IF(IRRT.NE.1) GOTO 7127
  1777. 6127 CONTINUE
  1778. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1779. * SEGINI XMATRI
  1780. * IMATTT(IB)=XMATRI
  1781. c
  1782. c remplissage de xmatri
  1783. c
  1784. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1785. * SEGDES XMATRI
  1786. 3127 CONTINUE
  1787. c
  1788. c impression d un eventuel message d erreur
  1789. c
  1790. IF(I195.NE.0) INTERR(1)=I195
  1791. IF(I195.NE.0) CALL ERREUR(195)
  1792. 7127 CONTINUE
  1793. IF(IRRT.EQ.0) THEN
  1794. MOTERR(1:4)=NOMTP(MELE)
  1795. CALL ERREUR(420)
  1796. ELSE
  1797. IF(IRRT.EQ.2) THEN
  1798. INTERR(1) = IB
  1799. CALL ERREUR(405)
  1800. ENDIF
  1801. ENDIF
  1802. IF(IRRT.EQ.3) CALL ERREUR(421)
  1803. IF(IRRT.EQ.4) CALL ERREUR(422)
  1804. SEGDES xMATRI
  1805. SEGSUP WRK1,WRK2,MVELCH
  1806. GOTO 510
  1807. c_______________________________________________________________________
  1808. c
  1809. c secteur de calcul pour les elements homogeneises
  1810. c (liquide solide) trh6
  1811. c_______________________________________________________________________
  1812. c
  1813. 157 CONTINUE
  1814. IF (ILUMP .EQ. 1) GOTO 99
  1815. NBNO=NBNN
  1816. NBBB=NBNN
  1817. SEGINI WRK1,WRK2
  1818. I195=0
  1819. DO 3157 IB=1,NBELEM
  1820. c
  1821. c on cherche les coordonnees des noeuds de l element ib
  1822. c
  1823. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1824. CALL ZERO (REL,LRE,LRE)
  1825. c
  1826. c on cherche les caracteristiques du materiau de l element ib
  1827. c
  1828. MPTVAL=IVAMAT
  1829. DO 8157 IM=1,NMATT
  1830. MELVAL=IVAL(IM)
  1831. IBMN=MIN(IB,VELCHE(/2))
  1832. VALMAT(IM)=VELCHE(1,IBMN)
  1833. 8157 CONTINUE
  1834. B11 =VALMAT(1)
  1835. B22 =VALMAT(2)
  1836. B12 =VALMAT(3)
  1837. RHOF =VALMAT(4)
  1838. RHOS =VALMAT(5)
  1839. C =VALMAT(6)
  1840. RHOREF=VALMAT(7)
  1841. CREF =VALMAT(8)
  1842. RLCAR =VALMAT(9)
  1843. E111 =VALMAT(10)
  1844. E112 =VALMAT(11)
  1845. E121 =VALMAT(12)
  1846. E122 =VALMAT(13)
  1847. E221 =VALMAT(14)
  1848. E222 =VALMAT(15)
  1849. c
  1850. c on cherche les caracteristiques geometriques de l element ib
  1851. c
  1852. MPTVAL=IVACAR
  1853. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  1854. MELVAL=IVAL(1)
  1855. IBMN=MIN(IB,VELCHE(/2))
  1856. SECT=VELCHE(1,IBMN)
  1857. MELVAL=IVAL(2)
  1858. IBMN=MIN(IB,VELCHE(/2))
  1859. SCEL=VELCHE(1,IBMN)
  1860. MELVAL=IVAL(3)
  1861. IBMN=MIN(IB,VELCHE(/2))
  1862. SFLU=VELCHE(1,IBMN)
  1863. MELVAL=IVAL(4)
  1864. IBMN=MIN(IB,VELCHE(/2))
  1865. EPS =VELCHE(1,IBMN)
  1866. ELSE
  1867. SECT=1.D0
  1868. MELVAL=IVAL(1)
  1869. IBMN=MIN(IB,VELCHE(/2))
  1870. SCEL=VELCHE(1,IBMN)
  1871. MELVAL=IVAL(2)
  1872. IBMN=MIN(IB,VELCHE(/2))
  1873. SFLU=VELCHE(1,IBMN)
  1874. MELVAL=IVAL(3)
  1875. IBMN=MIN(IB,VELCHE(/2))
  1876. EPS =VELCHE(1,IBMN)
  1877. MELVAL=IVAL(4)
  1878. IBMN=MIN(IB,VELCHE(/2))
  1879. F11 =VELCHE(1,IBMN)
  1880. MELVAL=IVAL(5)
  1881. IBMN=MIN(IB,VELCHE(/2))
  1882. F12 =VELCHE(1,IBMN)
  1883. ENDIF
  1884. c
  1885. c calcul de la masse m0/eps**2
  1886. c
  1887. RHOSS=RHOS*SECT/(EPS*EPS)
  1888. c
  1889. c calcul des coefficients de normalisation
  1890. c
  1891. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1892. COEFPI=RHOREF*RLCAR
  1893. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1894. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1895. VKL23 = COEFPI/SCEL
  1896. VKL33 = 1.D0/SCEL
  1897. VKL41 = EPS*EPS/2.D0/SCEL*(COEFPR*COEFPI)
  1898. VKL42 = EPS*EPS/2.D0/SCEL*COEFPI*COEFPI
  1899. VKL43 = EPS*EPS/2.D0/SCEL*COEFPI
  1900. VKL44 = EPS*EPS/2.D0/SCEL
  1901. c
  1902. c boucle sur les points de gauss
  1903. c cas plan
  1904. c
  1905. ISDJC=0
  1906. DO 6157 IGAU1=1,NBPGAU
  1907. POIGA1=MINTE.POIGAU(IGAU1)
  1908. CALL TRIHM31(IGAU1,MELE,NBNO,XE,SHPTOT,SHPWRK
  1909. # ,RHOSS,RHOF,
  1910. # B11,B22,B12,F11,F12,SFLU,SCEL,POIGA1,VKL12,VKL22,
  1911. # VKL23,VKL33,VKL42,VKL43,VKL44,E111,E112,E121,E122,
  1912. # E221,E222,LRE,REL,ISDJC,IRRT)
  1913. IF(IRRT.NE.1) GOTO 7092
  1914. 6157 CONTINUE
  1915. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1916. * SEGINI XMATRI
  1917. * IMATTT(IB)=XMATRI
  1918. c
  1919. c remplissage de xmatri
  1920. c
  1921. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1922. * SEGDES XMATRI
  1923. 3157 CONTINUE
  1924. c
  1925. c impression d un eventuel message d erreur
  1926. c
  1927. IF(I195.NE.0) INTERR(1)=I195
  1928. IF(I195.NE.0) CALL ERREUR(195)
  1929. 7157 CONTINUE
  1930. IF(IRRT.EQ.0) THEN
  1931. MOTERR(1:4)=NOMTP(MELE)
  1932. CALL ERREUR(420)
  1933. ELSE
  1934. IF(IRRT.EQ.2) THEN
  1935. INTERR(1) = IB
  1936. CALL ERREUR(405)
  1937. ENDIF
  1938. ENDIF
  1939. IF(IRRT.EQ.3) CALL ERREUR(421)
  1940. IF(IRRT.EQ.4) CALL ERREUR(422)
  1941. SEGDES xMATRI
  1942. SEGSUP WRK1,WRK2,MVELCH
  1943. GOTO 510
  1944. c_______________________________________________________________________
  1945. *
  1946. 99 CONTINUE
  1947. MOTERR(1:4)=NOMTP(MELE)
  1948. MOTERR(5:12)='MASSE4'
  1949. CALL ERREUR(86)
  1950. *
  1951. 510 CONTINUE
  1952. if (CMATE.EQ.'STATIQUE') then
  1953. mlmots = iinc
  1954. if (iinc.gt.0) segsup mlmots
  1955. mlmots = idua
  1956. if (idua.gt.0) segsup mlmots
  1957. endif
  1958. RETURN
  1959. END
  1960.  
  1961.  
  1962.  
  1963.  
  1964.  
  1965.  
  1966.  
  1967.  
  1968.  
  1969.  

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