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. CALL RACOMA(IFOUR,NIFOUR,IDIM,XE,CFPI,WORK,REL,LRE)
  701. c
  702. * SEGINI XMATRI
  703. * IMATTT(IB)=XMATRI
  704. c
  705. c remplissage de xmatri
  706. c
  707. CALL REMPMT(REL,LRE,RE(1,1,ib))
  708. * SEGDES XMATRI
  709. 3047 CONTINUE
  710. SEGDES xMATRI
  711. SEGSUP WRK3
  712. SEGSUP WRK1,MVELCH
  713. GOTO 510
  714. c_______________________________________________________________________
  715. c
  716. c secteur de calcul pour les elements de raccord
  717. c liquide coque 3 noeuds - cas tridimensionnel
  718. c_______________________________________________________________________
  719. c
  720. 55 CONTINUE
  721. IF (ILUMP .EQ. 1) GOTO 99
  722. NBBB=NBNN
  723. LW=IDIM
  724. SEGINI WRK1,WRK3
  725. DO 3055 IB=1,NBELEM
  726. c
  727. c on cherche les coordonnees de l element ib
  728. c
  729. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  730. CALL ZERO(REL,LRE,LRE)
  731. c
  732. c calcul des coefficients de normalisation
  733. c
  734. MPTVAL=IVAMAT
  735. DO 5055 IM=1,NMATT
  736. MELVAL=IVAL(IM)
  737. IBMN=MIN(IB,VELCHE(/2))
  738. VALMAT(IM)=VELCHE(1,IBMN)
  739. 5055 CONTINUE
  740. RHOREF=VALMAT(1)
  741. RLCAR = VALMAT(2)
  742. c
  743. CFPI= RHOREF*RLCAR
  744. c
  745. MPTVAL=IVACAR
  746. DO 4055 IC=1,NCARR
  747. IF (IVAL(IC).NE.0) THEN
  748. MELVAL=IVAL(IC)
  749. IBMN=MIN(IB,VELCHE(/2))
  750. WORK(IC)=VELCHE(1,IBMN)
  751. ELSE
  752. WORK(IC)=0.D0
  753. ENDIF
  754. 4055 CONTINUE
  755. c
  756. CALL LICOMA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
  757. 1 QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
  758. IF(IER246.NE.0) THEN
  759. CALL ERREUR(IER246)
  760. SEGSUP xMATRI
  761. SEGSUP WRK1,WRK3,MVELCH
  762. GOTO 510
  763. ENDIF
  764. * SEGINI XMATRI
  765. * IMATTT(IB)=XMATRI
  766. c
  767. c remplissage de xmatri
  768. c
  769. CALL REMPMT(REL,LRE,RE(1,1,ib))
  770. * SEGDES XMATRI
  771. 3055 CONTINUE
  772. SEGDES xMATRI
  773. SEGSUP WRK1,WRK3,MVELCH
  774. GOTO 510
  775. c_______________________________________________________________________
  776. c
  777. c secteur de calcul pour les elements joints joi2
  778. c_______________________________________________________________________
  779. c
  780. 85 CONTINUE
  781. IF (ILUMP .EQ. 1) GOTO 99
  782. NBNO=NBNN
  783. NBBB=NBNN
  784. SEGINI WRK1,WRK2,WRK4
  785. I195=0
  786. I259=0
  787. DO 3085 IB=1,NBELEM
  788. c
  789. c on cherche les coordonnees des noeuds de l element ib
  790. c
  791. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  792. CALL ZERO (REL,LRE,LRE)
  793. c
  794. c calcul des coordonnees locales de l'element
  795. c
  796. CALL JO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  797. c
  798. c boucle sur les points de gauss
  799. c
  800. ISDJC=0
  801. DO 4085 IGAU=1,NBPGAU
  802. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  803. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  804. *
  805. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  806. IF(DJAC.EQ.0.) I259=IB
  807. DJAC=ABS(DJAC)*POIGAU(IGAU)
  808. MPTVAL=IVAMAT
  809. IF (IVAL(1).NE.0) THEN
  810. MELVAL=IVAL(1)
  811. IGMN=MIN(IGAU,VELCHE(/1))
  812. IBMN=MIN(IB,VELCHE(/2))
  813. VALMAT(1)=VELCHE(IGMN,IBMN)
  814. ELSE
  815. VALMAT(1)=0.D0
  816. ENDIF
  817. CCCCCCCCCCC DJAC=DJAC*VALMAT(1)/3.0D0
  818. C
  819. C IL FAUT DIVISER PAR 4, CE QUI CORRESPOND PLUS EXACTEMENT A DIVISER
  820. C LE B PAR 2...
  821. C
  822. DJAC=DJAC*VALMAT(1)/4.0D0
  823. c
  824. c cas axisymetrique : multiplication par le rayon de courbure
  825. c
  826. IF (IFOUR.EQ.0) THEN
  827. RAYON = 0.D0
  828. NUMSUP=NBNO/2
  829. DO 4185 IRAY=1,NUMSUP
  830. RAYON=RAYON + ( SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) )
  831. 4185 CONTINUE
  832. DJAC=DJAC*RAYON
  833. ENDIF
  834. c
  835. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  836. 4085 CONTINUE
  837. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  838. * SEGINI XMATRI
  839. * IMATTT(IB)=XMATRI
  840. c
  841. c remplissage de xmatri
  842. c
  843. CALL REMPMT(REL,LRE,RE(1,1,ib))
  844. * SEGDES XMATRI
  845. 3085 CONTINUE
  846. IF(I195.NE.0) INTERR(1)=I195
  847. IF(I195.NE.0) CALL ERREUR(195)
  848. IF(I259.NE.0) INTERR(1)=I259
  849. IF(I259.NE.0) CALL ERREUR(259)
  850. SEGDES xMATRI
  851. SEGSUP WRK1,WRK2,WRK4,MVELCH
  852. GOTO 510
  853. c_______________________________________________________________________
  854. c
  855. c secteur de calcul pour les elements joints jot3
  856. c_______________________________________________________________________
  857. c
  858. 87 CONTINUE
  859. IF (ILUMP .EQ. 1) GOTO 99
  860. NBNO=NBNN
  861. NBBB=NBNN
  862. SEGINI WRK1,WRK2,WRK4
  863. I195=0
  864. I259=0
  865. DO 3087 IB=1,NBELEM
  866. c
  867. c on cherche les coordonnees des noeuds de l element ib
  868. c
  869. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  870. CALL ZERO (REL,LRE,LRE)
  871. c
  872. c calcul des coordonnees locales de l'element
  873. c
  874. CALL JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  875. c
  876. c boucle sur les points de gauss
  877. c
  878. ISDJC=0
  879. DO 4087 IGAU=1,NBPGAU
  880. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  881. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  882. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  883. IF(DJAC.EQ.0.) I259=IB
  884. DJAC=ABS(DJAC)*POIGAU(IGAU)
  885. MPTVAL=IVAMAT
  886. IF (IVAL(1).NE.0) THEN
  887. MELVAL=IVAL(1)
  888. IGMN=MIN(IGAU,VELCHE(/1))
  889. IBMN=MIN(IB,VELCHE(/2))
  890. VALMAT(1)=VELCHE(IGMN,IBMN)
  891. ELSE
  892. VALMAT(1)=0.D0
  893. ENDIF
  894. DJAC=DJAC*VALMAT(1)
  895. CCCCCCCCCCC DJAC=DJAC/3.0D0
  896. C IL FAUT DIVISER PAR 4, CE QUI CORRESPOND PLUS EXACTEMENT A DIVISER
  897. C LE B PAR 2...
  898. DJAC=DJAC/4.0D0
  899. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  900. 4087 CONTINUE
  901. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  902. * SEGINI XMATRI
  903. * IMATTT(IB)=XMATRI
  904. c
  905. c remplissage de xmatri
  906. c
  907. CALL REMPMT(REL,LRE,RE(1,1,ib))
  908. * SEGDES XMATRI
  909. 3087 CONTINUE
  910. IF(I195.NE.0) INTERR(1)=I195
  911. IF(I195.NE.0) CALL ERREUR(195)
  912. IF(I259.NE.0) INTERR(1)=I259
  913. IF(I259.NE.0) CALL ERREUR(259)
  914. SEGDES xMATRI
  915. SEGSUP WRK1,WRK2,WRK4,MVELCH
  916. GOTO 510
  917. c_______________________________________________________________________
  918. c
  919. c secteur de calcul pour les elements joints joi4
  920. c_______________________________________________________________________
  921. c
  922. 88 CONTINUE
  923. IF (ILUMP .EQ. 1) GOTO 99
  924. NBNO=NBNN
  925. NBBB=NBNN
  926. SEGINI WRK1,WRK2,WRK4
  927. I195=0
  928. I259=0
  929. DO 3088 IB=1,NBELEM
  930. c
  931. c on cherche les coordonnees des noeuds de l element ib
  932. c
  933. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  934. CALL ZERO (REL,LRE,LRE)
  935. c
  936. c calcul des coordonnees locales de l'element
  937. c
  938. CALL JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  939. c
  940. c boucle sur les points de gauss
  941. c
  942. ISDJC=0
  943. DO 4088 IGAU=1,NBPGAU
  944. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  945. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  946. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  947. IF(DJAC.EQ.0.) I259=IB
  948. DJAC=ABS(DJAC)*POIGAU(IGAU)
  949. MPTVAL=IVAMAT
  950. IF (IVAL(1).NE.0) THEN
  951. MELVAL=IVAL(1)
  952. IGMN=MIN(IGAU,VELCHE(/1))
  953. IBMN=MIN(IB,VELCHE(/2))
  954. VALMAT(1)=VELCHE(IGMN,IBMN)
  955. ELSE
  956. VALMAT(1)=0.D0
  957. ENDIF
  958. DJAC=DJAC*VALMAT(1)
  959. CCCCCCCCCCCC DJAC=DJAC/3.0D0
  960. C IL FAUT DIVISER PAR 4, CE QUI CORRESPOND PLUS EXACTEMENT A DIVISER
  961. C LE B PAR 2...
  962. DJAC=DJAC/4.0D0
  963. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  964. 4088 CONTINUE
  965. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  966. * SEGINI XMATRI
  967. * IMATTT(IB)=XMATRI
  968. c
  969. c remplissage de xmatri
  970. c
  971. CALL REMPMT(REL,LRE,RE(1,1,ib))
  972. * SEGDES XMATRI
  973. 3088 CONTINUE
  974. IF(I195.NE.0) INTERR(1)=I195
  975. IF(I195.NE.0) CALL ERREUR(195)
  976. IF(I259.NE.0) INTERR(1)=I259
  977. IF(I259.NE.0) CALL ERREUR(259)
  978. SEGDES xMATRI
  979. SEGSUP WRK1,WRK2,WRK4,MVELCH
  980. GOTO 510
  981. c_______________________________________________________________________
  982. c
  983. c secteur de calcul pour les elements joints jgi2
  984. c_______________________________________________________________________
  985. c
  986. 170 CONTINUE
  987. IF (IFOUR.EQ.-3) NDDL=NDDL+1
  988. IF (ILUMP .EQ. 1) GOTO 99
  989. NBNO=NBNN
  990. NBBB=NBNN
  991. SEGINI WRK1,WRK2,WRK4
  992. I195=0
  993. I259=0
  994. C
  995. IG1=0
  996. C
  997. DO IB=1,NBELEM
  998. c
  999. c on cherche les coordonnees des noeuds de l element ib
  1000. c
  1001. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1002. CALL ZERO (REL,LRE,LRE)
  1003. c
  1004. c calcul des coordonnees locales de l'element
  1005. c
  1006. CALL JO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1007. c
  1008. c boucle sur les points de gauss
  1009. c
  1010. ISDJC=0
  1011. DO IGAU=1,NBPGAU
  1012. MPTVAL=IVAMAT
  1013. DO IM=1,NMATT
  1014. MELVAL=IVAL(IM)
  1015. IGMN=MIN(IGAU,VELCHE(/1))
  1016. IBMN=MIN(IB,VELCHE(/2))
  1017. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1018. ENDDO
  1019. C
  1020. EPAIST=VALMAT(2)
  1021. IF(EPAIST.EQ.0.D0)THEN
  1022. CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,
  1023. . SHPWRK,EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT)
  1024. IF(IERT.NE.0) IG1=IB
  1025. ENDIF
  1026. C
  1027. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1028. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1029. *
  1030. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1031. IF(DJAC.EQ.0.) I259=IB
  1032. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1033. *
  1034. c valmat(1)=rho, valmat(2)=epai
  1035. c /4 correspnnd en fait a diviser les matrices B par 2
  1036. CCCCCCCCCCCC DJAC=DJAC*VALMAT(1)*VALMAT(2)/4.0D0
  1037. DJAC=DJAC*VALMAT(1)*EPAIST/4.0D0
  1038. c
  1039. c cas axisymetrique : multiplication par le rayon de courbure
  1040. c
  1041. IF (IFOUR.EQ.0) THEN
  1042. RAYON = 0.D0
  1043. NUMSUP=NBNO/2
  1044. DO IRAY=1,NUMSUP
  1045. RAYON=RAYON + ( SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) )
  1046. ENDDO
  1047. DJAC=DJAC*RAYON
  1048. ENDIF
  1049. c
  1050. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1051. ENDDO
  1052. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1053. * SEGINI XMATRI
  1054. * IMATTT(IB)=XMATRI
  1055. c
  1056. c remplissage de xmatri
  1057. c
  1058. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1059. * SEGDES XMATRI
  1060. ENDDO
  1061. C
  1062. IF(IG1.NE.0) INTERR(1)=IG1
  1063. IF(IG1.NE.0) CALL ERREUR (611)
  1064. C
  1065. IF(I195.NE.0) INTERR(1)=I195
  1066. IF(I195.NE.0) CALL ERREUR(195)
  1067. IF(I259.NE.0) INTERR(1)=I259
  1068. IF(I259.NE.0) CALL ERREUR(259)
  1069. SEGDES xMATRI
  1070. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1071. GOTO 510
  1072. C
  1073. c_______________________________________________________________________
  1074. c
  1075. c secteur de calcul pour les elements joints jct3 en 2D cisaillement
  1076. c_______________________________________________________________________
  1077. c
  1078. 168 CONTINUE
  1079. IF (ILUMP .EQ. 1) GOTO 99
  1080. NBNO=NBNN
  1081. NBBB=NBNN
  1082. SEGINI WRK1,WRK2,WRK4
  1083. I195=0
  1084. I259=0
  1085. DO IB=1,NBELEM
  1086. c
  1087. c on cherche les coordonnees des noeuds de l element ib
  1088. c
  1089. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1090. CALL ZERO (REL,LRE,LRE)
  1091. c
  1092. c calcul des coordonnees locales de l'element
  1093. c
  1094. CALL JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1095. c
  1096. c boucle sur les points de gauss
  1097. c
  1098. ISDJC=0
  1099. DO IGAU=1,NBPGAU
  1100. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1101. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1102. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1103. IF(DJAC.EQ.0.) I259=IB
  1104. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1105. MPTVAL=IVAMAT
  1106. IF (IVAL(1).NE.0) THEN
  1107. MELVAL=IVAL(1)
  1108. IGMN=MIN(IGAU,VELCHE(/1))
  1109. IBMN=MIN(IB,VELCHE(/2))
  1110. VALMAT(1)=VELCHE(IGMN,IBMN)
  1111. ELSE
  1112. VALMAT(1)=0.D0
  1113. ENDIF
  1114. DJAC=DJAC*VALMAT(1)
  1115. CCCCCCCCCC DJAC=DJAC/3.0D0
  1116. C Il faut diviser par 4, ce qui correspond plus exactement a diviser
  1117. C le B par 2...
  1118. DJAC=DJAC/4.0D0
  1119. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1120. ENDDO
  1121. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1122. * SEGINI XMATRI
  1123. * IMATTT(IB)=XMATRI
  1124. c
  1125. c remplissage de xmatri
  1126. c
  1127. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1128. SEGDES XMATRI
  1129. ENDDO
  1130. IF(I195.NE.0) INTERR(1)=I195
  1131. IF(I195.NE.0) CALL ERREUR(195)
  1132. IF(I259.NE.0) INTERR(1)=I259
  1133. IF(I259.NE.0) CALL ERREUR(259)
  1134. SEGDES xMATRI
  1135. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1136. GOTO 510
  1137. c_______________________________________________________________________
  1138. c
  1139. c secteur de calcul pour les elements joints jgt3 generalise
  1140. c_______________________________________________________________________
  1141. c
  1142. 171 CONTINUE
  1143. IF (ILUMP .EQ. 1) GOTO 99
  1144. NBNO=NBNN
  1145. NBBB=NBNN
  1146. SEGINI WRK1,WRK2,WRK4
  1147. I195=0
  1148. I259=0
  1149. C
  1150. IG1=0
  1151. C
  1152. DO IB=1,NBELEM
  1153. c
  1154. c on cherche les coordonnees des noeuds de l element ib
  1155. c
  1156. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1157. CALL ZERO (REL,LRE,LRE)
  1158. c
  1159. c calcul des coordonnees locales de l'element
  1160. c
  1161. CALL JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1162. c
  1163. c boucle sur les points de gauss
  1164. c
  1165. ISDJC=0
  1166. DO IGAU=1,NBPGAU
  1167. MPTVAL=IVAMAT
  1168. DO IM=1,NMATT
  1169. MELVAL=IVAL(IM)
  1170. IGMN=MIN(IGAU,VELCHE(/1))
  1171. IBMN=MIN(IB,VELCHE(/2))
  1172. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1173. ENDDO
  1174. C
  1175. EPAIST=VALMAT(2)
  1176. IF(EPAIST.EQ.0.D0)THEN
  1177. CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,
  1178. . SHPWRK,EPAIST,BGENE,DJAC,IERT)
  1179. IF(IERT.NE.0) IG1=IB
  1180. ENDIF
  1181. C
  1182. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1183. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1184. *
  1185. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1186. IF(DJAC.EQ.0.) I259=IB
  1187. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1188. *
  1189. c valmat(1)=rho, valmat(2)=epai
  1190. c /4 correspnnd en fait a diviser les matrices B par 2
  1191. CCCCCCCCCCCC DJAC=DJAC*VALMAT(1)*VALMAT(2)/4.0D0
  1192. DJAC=DJAC*VALMAT(1)*EPAIST/4.0D0
  1193. *
  1194. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1195. ENDDO
  1196. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1197. * SEGINI XMATRI
  1198. * IMATTT(IB)=XMATRI
  1199. c
  1200. c remplissage de xmatri
  1201. c
  1202. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1203. * SEGDES XMATRI
  1204. ENDDO
  1205. C
  1206. IF(IG1.NE.0) INTERR(1)=IG1
  1207. IF(IG1.NE.0) CALL ERREUR 611)
  1208. C
  1209. IF(I195.NE.0) INTERR(1)=I195
  1210. IF(I195.NE.0) CALL ERREUR(195)
  1211. IF(I259.NE.0) INTERR(1)=I259
  1212. IF(I259.NE.0) CALL ERREUR(259)
  1213. SEGDES xMATRI
  1214. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1215. GOTO 510
  1216. C
  1217. c_______________________________________________________________________
  1218. c
  1219. c secteur de calcul pour les elements joints jci4 en 2D cisaillement
  1220. c_______________________________________________________________________
  1221. c
  1222. 169 CONTINUE
  1223. IF (ILUMP .EQ. 1) GOTO 99
  1224. NBNO=NBNN
  1225. NBBB=NBNN
  1226. SEGINI WRK1,WRK2,WRK4
  1227. I195=0
  1228. I259=0
  1229. DO IB=1,NBELEM
  1230. c
  1231. c on cherche les coordonnees des noeuds de l element ib
  1232. c
  1233. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1234. CALL ZERO (REL,LRE,LRE)
  1235. c
  1236. c calcul des coordonnees locales de l'element
  1237. c
  1238. CALL JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1239. c
  1240. c boucle sur les points de gauss
  1241. c
  1242. ISDJC=0
  1243. DO IGAU=1,NBPGAU
  1244. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1245. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1246. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1247. IF(DJAC.EQ.0.) I259=IB
  1248. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1249. MPTVAL=IVAMAT
  1250. IF (IVAL(1).NE.0) THEN
  1251. MELVAL=IVAL(1)
  1252. IGMN=MIN(IGAU,VELCHE(/1))
  1253. IBMN=MIN(IB,VELCHE(/2))
  1254. VALMAT(1)=VELCHE(IGMN,IBMN)
  1255. ELSE
  1256. VALMAT(1)=0.D0
  1257. ENDIF
  1258. DJAC=DJAC*VALMAT(1)
  1259. CCCCCCCCCCC DJAC=DJAC/3.0D0
  1260. C Il faut diviser par 4, ce qui correspond plus exactement a diviser
  1261. C le B par 2...
  1262. DJAC=DJAC/4.0D0
  1263. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1264. ENDDO
  1265. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1266. * SEGINI XMATRI
  1267. * IMATTT(IB)=XMATRI
  1268. c
  1269. c remplissage de xmatri
  1270. c
  1271. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1272. * SEGDES XMATRI
  1273. ENDDO
  1274. IF(I195.NE.0) INTERR(1)=I195
  1275. IF(I195.NE.0) CALL ERREUR(195)
  1276. IF(I259.NE.0) INTERR(1)=I259
  1277. IF(I259.NE.0) CALL ERREUR(259)
  1278. SEGDES xMATRI
  1279. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1280. GOTO 510
  1281. c_______________________________________________________________________
  1282. c
  1283. c secteur de calcul pour les elements joints jgi4 generalise
  1284. c_______________________________________________________________________
  1285. c
  1286. 172 CONTINUE
  1287. IF (ILUMP .EQ. 1) GOTO 99
  1288. NBNO=NBNN
  1289. NBBB=NBNN
  1290. SEGINI WRK1,WRK2,WRK4
  1291. I195=0
  1292. I259=0
  1293. C
  1294. IG1=0
  1295. C
  1296. DO IB=1,NBELEM
  1297. c
  1298. c on cherche les coordonnees des noeuds de l element ib
  1299. c
  1300. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1301. CALL ZERO (REL,LRE,LRE)
  1302. c
  1303. c calcul des coordonnees locales de l'element
  1304. c
  1305. CALL JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  1306. c
  1307. c boucle sur les points de gauss
  1308. c
  1309. ISDJC=0
  1310. DO IGAU=1,NBPGAU
  1311. MPTVAL=IVAMAT
  1312. DO IM=1,NMATT
  1313. MELVAL=IVAL(IM)
  1314. IGMN=MIN(IGAU,VELCHE(/1))
  1315. IBMN=MIN(IB,VELCHE(/2))
  1316. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1317. ENDDO
  1318. C
  1319. EPAIST=VALMAT(2)
  1320. IF(EPAIST.EQ.0.D0)THEN
  1321. CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,
  1322. . BGENE,DJAC,IERT)
  1323. IF(IERT.NE.0) IG1=IB
  1324. ENDIF
  1325. C
  1326. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  1327. 1 1.D0,XEL,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  1328. *
  1329. IF(DJAC.LT.0.) ISDJC=ISDJC+1
  1330. IF(DJAC.EQ.0.) I259=IB
  1331. DJAC=ABS(DJAC)*POIGAU(IGAU)
  1332. *
  1333. c valmat(1)=rho, valmat(2)=epai
  1334. c /4 correspnnd en fait a diviser les matrices B par 2
  1335. CCCCCCCCCCCC DJAC=DJAC*VALMAT(1)*VALMAT(2)/4.0D0
  1336. DJAC=DJAC*VALMAT(1)*EPAIST/4.0D0
  1337. *
  1338. CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  1339. ENDDO
  1340. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1341. * SEGINI XMATRI
  1342. * IMATTT(IB)=XMATRI
  1343. c
  1344. c remplissage de xmatri
  1345. c
  1346. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1347. * SEGDES XMATRI
  1348. ENDDO
  1349. C
  1350. IF(IG1.NE.0) INTERR(1)=IG1
  1351. IF(IG1.NE.0) CALL ERREUR (611)
  1352. C
  1353. IF(I195.NE.0) INTERR(1)=I195
  1354. IF(I195.NE.0) CALL ERREUR(195)
  1355. IF(I259.NE.0) INTERR(1)=I259
  1356. IF(I259.NE.0) CALL ERREUR(259)
  1357. SEGDES xMATRI
  1358. SEGSUP WRK1,WRK2,WRK4,MVELCH
  1359. GOTO 510
  1360. C
  1361. c_______________________________________________________________________
  1362. c
  1363. c secteur de calcul pour les elements homogeneises
  1364. c (liquide solide) trih
  1365. c_______________________________________________________________________
  1366. c
  1367. 92 CONTINUE
  1368. IF (ILUMP .EQ. 1) GOTO 99
  1369. NBNO=NBNN
  1370. NBBB=NBNN
  1371. SEGINI WRK1,WRK2
  1372. I195=0
  1373. DO 3092 IB=1,NBELEM
  1374. c
  1375. c on cherche les coordonnees des noeuds de l element ib
  1376. c
  1377. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1378. CALL ZERO (REL,LRE,LRE)
  1379. c
  1380. c on cherche les caracteristiques du materiau de l element ib
  1381. c
  1382. MPTVAL=IVAMAT
  1383. DO 8092 IM=1,NMATT
  1384. MELVAL=IVAL(IM)
  1385. IBMN=MIN(IB,VELCHE(/2))
  1386. VALMAT(IM)=VELCHE(1,IBMN)
  1387. 8092 CONTINUE
  1388. B11 =VALMAT(1)
  1389. B22 =VALMAT(2)
  1390. B12 =VALMAT(3)
  1391. RHOF =VALMAT(4)
  1392. RHOS =VALMAT(5)
  1393. C =VALMAT(6)
  1394. RHOREF=VALMAT(7)
  1395. CREF =VALMAT(8)
  1396. RLCAR =VALMAT(9)
  1397. c
  1398. c on cherche les caracteristiques geometriques de l element ib
  1399. c
  1400. MPTVAL=IVACAR
  1401. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  1402. MELVAL=IVAL(1)
  1403. IBMN=MIN(IB,VELCHE(/2))
  1404. SECT=VELCHE(1,IBMN)
  1405. MELVAL=IVAL(2)
  1406. IBMN=MIN(IB,VELCHE(/2))
  1407. SCEL=VELCHE(1,IBMN)
  1408. MELVAL=IVAL(3)
  1409. IBMN=MIN(IB,VELCHE(/2))
  1410. SFLU=VELCHE(1,IBMN)
  1411. MELVAL=IVAL(4)
  1412. IBMN=MIN(IB,VELCHE(/2))
  1413. EPS =VELCHE(1,IBMN)
  1414. ELSE
  1415. SECT=1.D0
  1416. MELVAL=IVAL(1)
  1417. IBMN=MIN(IB,VELCHE(/2))
  1418. SCEL=VELCHE(1,IBMN)
  1419. MELVAL=IVAL(2)
  1420. IBMN=MIN(IB,VELCHE(/2))
  1421. SFLU=VELCHE(1,IBMN)
  1422. MELVAL=IVAL(3)
  1423. IBMN=MIN(IB,VELCHE(/2))
  1424. EPS =VELCHE(1,IBMN)
  1425. MELVAL=IVAL(4)
  1426. IBMN=MIN(IB,VELCHE(/2))
  1427. F11 =VELCHE(1,IBMN)
  1428. MELVAL=IVAL(5)
  1429. IBMN=MIN(IB,VELCHE(/2))
  1430. F12 =VELCHE(1,IBMN)
  1431. ENDIF
  1432. c
  1433. c calcul de la masse m0/eps**2
  1434. c
  1435. RHOSS=RHOS*SECT/(EPS*EPS)
  1436. c
  1437. c calcul des coefficients de normalisation
  1438. c
  1439. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1440. COEFPI=RHOREF*RLCAR
  1441. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1442. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1443. VKL23 = COEFPI/SCEL
  1444. VKL33 = 1.D0/SCEL
  1445. IF(IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  1446. VKL23 =COEFPI*0.5D0*(2.D0*SCEL-B11-B22)/SCEL
  1447. VKL33 =(RHOSS+RHOF*(SFLU-(B11+B22)/2.D0))/SCEL
  1448. c
  1449. c calcul des termes en pi*pi
  1450. c integration par nbpgau points de gauss
  1451. c
  1452. ISDJC=0
  1453. DO 4092 IGAU=1,NBPGAU
  1454. POIGA2=MINTE.POIGAU(IGAU)
  1455. CALL TRIHM1(IGAU,MELE,MFR,NBNO,XE,SHPTOT,SHPWRK,
  1456. # IFOUR,NHRM,B11,B22,SFLU,POIGA2,VKL22,LRE,REL,IRRT)
  1457. IF(IRRT.NE.1) GOTO 7092
  1458. c
  1459. c calcul du reste des termes de la matrice masse
  1460. c integration par nbpgau points de gauss
  1461. c
  1462. CALL TRIHM2(IGAU,MELE,MFR,NBNO,XE,MINTE.SHPTOT,SHPWRK
  1463. # ,IFOUR,NHRM,VKL12,VKL23,VKL33,POIGA2,ISDJC,LRE,REL,IRRT)
  1464. IF(IRRT.NE.1) GOTO 7092
  1465. 4092 CONTINUE
  1466. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1467. ELSE
  1468. c
  1469. c boucle sur les points de gauss
  1470. c cas plan
  1471. c
  1472. ISDJC=0
  1473. DO 6092 IGAU1=1,NBPGAU
  1474. POIGA1=MINTE.POIGAU(IGAU1)
  1475. CALL TRIHM3(IGAU1,MELE,NBNO,XE,SHPTOT,SHPWRK
  1476. # ,RHOSS,RHOF,
  1477. # B11,B22,B12,F11,F12,SFLU,SCEL,POIGA1,VKL12,VKL22,
  1478. # VKL23,VKL33,LRE,REL,ISDJC,IRRT)
  1479. IF(IRRT.NE.1) GOTO 7092
  1480. 6092 CONTINUE
  1481. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1482. ENDIF
  1483. * SEGINI XMATRI
  1484. * IMATTT(IB)=XMATRI
  1485. c
  1486. c remplissage de xmatri
  1487. c
  1488. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1489. * SEGDES XMATRI
  1490. 3092 CONTINUE
  1491. c
  1492. c impression d un eventuel message d erreur
  1493. c
  1494. IF(I195.NE.0) INTERR(1)=I195
  1495. IF(I195.NE.0) CALL ERREUR(195)
  1496. 7092 CONTINUE
  1497. IF(IRRT.EQ.0) THEN
  1498. MOTERR(1:4)=NOMTP(MELE)
  1499. CALL ERREUR(420)
  1500. ELSE
  1501. IF(IRRT.EQ.2) THEN
  1502. INTERR(1) = IB
  1503. CALL ERREUR(405)
  1504. ENDIF
  1505. ENDIF
  1506. IF(IRRT.EQ.3) CALL ERREUR(421)
  1507. IF(IRRT.EQ.4) CALL ERREUR(422)
  1508. SEGDES xMATRI
  1509. SEGSUP WRK1,WRK2,MVELCH
  1510. GOTO 510
  1511. c_______________________________________________________________________
  1512. c
  1513. c secteur de calcul pour les elements de raccord
  1514. c liquide coque 4 noeuds - cas tridimensionnel
  1515. c_______________________________________________________________________
  1516. c
  1517. 94 CONTINUE
  1518. IF (ILUMP .EQ. 1) GOTO 99
  1519. NBBB=NBNN
  1520. LW=IDIM
  1521. SEGINI WRK1,WRK3
  1522. DO 3094 IB=1,NBELEM
  1523. c
  1524. c on cherche les coordonnees de l element ib
  1525. c
  1526. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1527. CALL ZERO(REL,LRE,LRE)
  1528. c
  1529. c calcul des coefficients de normalisation
  1530. c
  1531. MPTVAL=IVAMAT
  1532. DO 5094 IM=1,NMATT
  1533. MELVAL=IVAL(IM)
  1534. IBMN=MIN(IB,VELCHE(/2))
  1535. VALMAT(IM)=VELCHE(1,IBMN)
  1536. 5094 CONTINUE
  1537. RHOREF=VALMAT(1)
  1538. RLCAR = VALMAT(2)
  1539. c
  1540. CFPI= RHOREF*RLCAR
  1541. c
  1542. MPTVAL=IVACAR
  1543. DO 4094 IC=1,NCARR
  1544. IF (IVAL(IC).NE.0) THEN
  1545. MELVAL=IVAL(IC)
  1546. IBMN=MIN(IB,VELCHE(/2))
  1547. WORK(IC)=VELCHE(1,IBMN)
  1548. ELSE
  1549. WORK(IC)=0.D0
  1550. ENDIF
  1551. 4094 CONTINUE
  1552. c
  1553. CALL LIC4MA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
  1554. 1 QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
  1555. IF(IER246.NE.0) THEN
  1556. CALL ERREUR(IER246)
  1557. SEGSUP xMATRI
  1558. SEGSUP WRK1,WRK3,MVELCH
  1559. GOTO 510
  1560. ENDIF
  1561. * SEGINI XMATRI
  1562. * IMATTT(IB)=XMATRI
  1563. c
  1564. c remplissage de xmatri
  1565. c
  1566. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1567. * SEGDES XMATRI
  1568. 3094 CONTINUE
  1569. SEGDES xMATRI
  1570. SEGSUP WRK1,WRK3,MVELCH
  1571. GOTO 510
  1572. c_______________________________________________________________________
  1573. c
  1574. c secteur de calcul pour les elements homogeneises
  1575. c (liquide solide) quah
  1576. c_______________________________________________________________________
  1577. c
  1578. 126 CONTINUE
  1579. c
  1580. IF (ILUMP .EQ. 1) GOTO 99
  1581. NBNO=NBNN
  1582. NBBB=NBNN
  1583. SEGINI WRK1,WRK2
  1584. I195=0
  1585. DO 3126 IB=1,NBELEM
  1586. c
  1587. c on cherche les coordonnees des noeuds de l element ib
  1588. c
  1589. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1590. CALL ZERO (REL,LRE,LRE)
  1591. c
  1592. c on cherche les caracteristiques du materiau de l element ib
  1593. c
  1594. MPTVAL=IVAMAT
  1595. DO 8126 IM=1,NMATT
  1596. MELVAL=IVAL(IM)
  1597. IBMN=MIN(IB,VELCHE(/2))
  1598. VALMAT(IM)=VELCHE(1,IBMN)
  1599. 8126 CONTINUE
  1600. B11 =VALMAT(1)
  1601. B22 =VALMAT(2)
  1602. B12 =VALMAT(3)
  1603. RHOF =VALMAT(4)
  1604. RHOS =VALMAT(5)
  1605. C =VALMAT(6)
  1606. RHOREF=VALMAT(7)
  1607. CREF =VALMAT(8)
  1608. RLCAR =VALMAT(9)
  1609. c
  1610. c on cherche les caracteristiques geometriques de l element ib
  1611. c
  1612. MPTVAL=IVACAR
  1613. MELVAL=IVAL(4)
  1614. IBMN=MIN(IB,VELCHE(/2))
  1615. SECT=VELCHE(1,IBMN)
  1616. c
  1617. MELVAL=IVAL(1)
  1618. IBMN=MIN(IB,VELCHE(/2))
  1619. SCEL=VELCHE(1,IBMN)
  1620. c
  1621. MELVAL=IVAL(2)
  1622. IBMN=MIN(IB,VELCHE(/2))
  1623. SFLU=VELCHE(1,IBMN)
  1624. c
  1625. MELVAL=IVAL(3)
  1626. IBMN=MIN(IB,VELCHE(/2))
  1627. EPS =VELCHE(1,IBMN)
  1628. c
  1629. c
  1630. c calcul de la masse m0/eps**2
  1631. c
  1632. RHOSS=RHOS*SECT/(EPS*EPS)
  1633. c
  1634. c calcul des coefficients de normalisation
  1635. c
  1636. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1637. COEFPI=RHOREF*RLCAR
  1638. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1639. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1640. VKL23 =COEFPI*0.5D0*(2.D0*SCEL-B11-B22)/SCEL
  1641. VKL33 =(RHOSS+RHOF*(SFLU-(B11+B22)/2.D0))/SCEL
  1642. c
  1643. c
  1644. c calcul des termes en pi*pi
  1645. c integration par nbpgau points de gauss
  1646. c
  1647. ISDJC=0
  1648. DO 4126 IGAU=1,NBPGAU
  1649. POIGA2=MINTE.POIGAU(IGAU)
  1650. CALL QUAHM1(IGAU,MELE,MFR,NBNO,XE,SHPTOT,SHPWRK,IFOUR
  1651. # ,NHRM,B11,B22,SFLU,POIGA2,VKL22,LRE,REL,IRRT)
  1652. IF(IRRT.NE.1) GOTO 7126
  1653. c
  1654. c calcul du reste des termes de la matrice masse
  1655. c integration par nbpgau points de gauss
  1656. c
  1657. CALL QUAHM2(IGAU,MELE,MFR,NBNO,XE,MINTE.SHPTOT,SHPWRK
  1658. # ,IFOUR,NHRM,VKL12,VKL23,VKL33,POIGA2,ISDJC,LRE,REL,IRRT)
  1659. IF(IRRT.NE.1) GOTO 7126
  1660. 4126 CONTINUE
  1661. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1662. c
  1663. * SEGINI XMATRI
  1664. * IMATTT(IB)=XMATRI
  1665. c
  1666. c remplissage de xmatri
  1667. c
  1668. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1669. * SEGDES XMATRI
  1670. 3126 CONTINUE
  1671. c
  1672. c impression d un eventuel message d erreur
  1673. c
  1674. IF(I195.NE.0) INTERR(1)=I195
  1675. IF(I195.NE.0) CALL ERREUR(195)
  1676. 7126 CONTINUE
  1677. IF(IRRT.EQ.0) THEN
  1678. MOTERR(1:4)=NOMTP(MELE)
  1679. CALL ERREUR(420)
  1680. ELSE
  1681. IF(IRRT.EQ.2) THEN
  1682. INTERR(1) = IB
  1683. CALL ERREUR(405)
  1684. ENDIF
  1685. ENDIF
  1686. IF(IRRT.EQ.3) CALL ERREUR(421)
  1687. IF(IRRT.EQ.4) CALL ERREUR(422)
  1688. SEGDES xMATRI
  1689. SEGSUP WRK1,WRK2,MVELCH
  1690. GOTO 510
  1691. c
  1692. c_______________________________________________________________________
  1693. c
  1694. c secteur de calcul pour les elements homogeneises
  1695. c (liquide solide) cubh
  1696. c_______________________________________________________________________
  1697. c
  1698. 127 CONTINUE
  1699. IF (ILUMP .EQ. 1) GOTO 99
  1700. NBNO=NBNN
  1701. NBBB=NBNN
  1702. LW=IDIM
  1703. SEGINI WRK1,WRK2
  1704. I195=0
  1705. DO 3127 IB=1,NBELEM
  1706. c
  1707. c on cherche les coordonnees des noeuds de l element ib
  1708. c
  1709. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1710. CALL ZERO (REL,LRE,LRE)
  1711. c
  1712. c on cherche les caracteristiques du materiau de l element ib
  1713. c
  1714. MPTVAL=IVAMAT
  1715. DO 8127 IM=1,NMATT
  1716. MELVAL=IVAL(IM)
  1717. IBMN=MIN(IB,VELCHE(/2))
  1718. VALMAT(IM)=VELCHE(1,IBMN)
  1719. 8127 CONTINUE
  1720. B11 =VALMAT(1)
  1721. B22 =VALMAT(2)
  1722. B12 =VALMAT(3)
  1723. RHOF =VALMAT(4)
  1724. RHOS =VALMAT(5)
  1725. C =VALMAT(6)
  1726. RHOREF=VALMAT(7)
  1727. CREF =VALMAT(8)
  1728. RLCAR =VALMAT(9)
  1729. c
  1730. c on cherche les caracteristiques geometriques de l element ib
  1731. c
  1732. MPTVAL=IVACAR
  1733. c
  1734. MELVAL=IVAL(1)
  1735. IBMN=MIN(IB,VELCHE(/2))
  1736. SCEL=VELCHE(1,IBMN)
  1737. c
  1738. MELVAL=IVAL(2)
  1739. IBMN=MIN(IB,VELCHE(/2))
  1740. SFLU=VELCHE(1,IBMN)
  1741. c
  1742. MELVAL=IVAL(3)
  1743. IBMN=MIN(IB,VELCHE(/2))
  1744. EPS =VELCHE(1,IBMN)
  1745. c
  1746. MELVAL=IVAL(4)
  1747. IBMN=MIN(IB,VELCHE(/2))
  1748. SECT =VELCHE(1,IBMN)
  1749. c
  1750. c calcul de la masse m0/eps**2
  1751. c
  1752. RHOSS=RHOS*SECT/(EPS*EPS)
  1753. c
  1754. c calcul des coefficients de normalisation
  1755. c
  1756. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1757. COEFPI=RHOREF*RLCAR
  1758. c
  1759. c
  1760. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1761. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1762. c
  1763. VKL23 = COEFPI/SCEL
  1764. VKL33 = 1.D0/SCEL
  1765. c
  1766. ISDJC=0
  1767. DO 6127 IGAU1=1,NBPGAU
  1768. POIGA1=MINTE.POIGAU(IGAU1)
  1769. CALL CUBHM1(IGAU1,MELE,NBNO,XE,SHPTOT,SHPWRK,
  1770. # RHOSS,RHOF,B11,B22,B12,SFLU,SCEL,POIGA1,VKL12,VKL22,VKL23,
  1771. # VKL33,LRE,REL,ISDJC,IRRT)
  1772. IF(IRRT.NE.1) GOTO 7127
  1773. 6127 CONTINUE
  1774. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1775. * SEGINI XMATRI
  1776. * IMATTT(IB)=XMATRI
  1777. c
  1778. c remplissage de xmatri
  1779. c
  1780. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1781. * SEGDES XMATRI
  1782. 3127 CONTINUE
  1783. c
  1784. c impression d un eventuel message d erreur
  1785. c
  1786. IF(I195.NE.0) INTERR(1)=I195
  1787. IF(I195.NE.0) CALL ERREUR(195)
  1788. 7127 CONTINUE
  1789. IF(IRRT.EQ.0) THEN
  1790. MOTERR(1:4)=NOMTP(MELE)
  1791. CALL ERREUR(420)
  1792. ELSE
  1793. IF(IRRT.EQ.2) THEN
  1794. INTERR(1) = IB
  1795. CALL ERREUR(405)
  1796. ENDIF
  1797. ENDIF
  1798. IF(IRRT.EQ.3) CALL ERREUR(421)
  1799. IF(IRRT.EQ.4) CALL ERREUR(422)
  1800. SEGDES xMATRI
  1801. SEGSUP WRK1,WRK2,MVELCH
  1802. GOTO 510
  1803. c_______________________________________________________________________
  1804. c
  1805. c secteur de calcul pour les elements homogeneises
  1806. c (liquide solide) trh6
  1807. c_______________________________________________________________________
  1808. c
  1809. 157 CONTINUE
  1810. IF (ILUMP .EQ. 1) GOTO 99
  1811. NBNO=NBNN
  1812. NBBB=NBNN
  1813. SEGINI WRK1,WRK2
  1814. I195=0
  1815. DO 3157 IB=1,NBELEM
  1816. c
  1817. c on cherche les coordonnees des noeuds de l element ib
  1818. c
  1819. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1820. CALL ZERO (REL,LRE,LRE)
  1821. c
  1822. c on cherche les caracteristiques du materiau de l element ib
  1823. c
  1824. MPTVAL=IVAMAT
  1825. DO 8157 IM=1,NMATT
  1826. MELVAL=IVAL(IM)
  1827. IBMN=MIN(IB,VELCHE(/2))
  1828. VALMAT(IM)=VELCHE(1,IBMN)
  1829. 8157 CONTINUE
  1830. B11 =VALMAT(1)
  1831. B22 =VALMAT(2)
  1832. B12 =VALMAT(3)
  1833. RHOF =VALMAT(4)
  1834. RHOS =VALMAT(5)
  1835. C =VALMAT(6)
  1836. RHOREF=VALMAT(7)
  1837. CREF =VALMAT(8)
  1838. RLCAR =VALMAT(9)
  1839. E111 =VALMAT(10)
  1840. E112 =VALMAT(11)
  1841. E121 =VALMAT(12)
  1842. E122 =VALMAT(13)
  1843. E221 =VALMAT(14)
  1844. E222 =VALMAT(15)
  1845. c
  1846. c on cherche les caracteristiques geometriques de l element ib
  1847. c
  1848. MPTVAL=IVACAR
  1849. IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  1850. MELVAL=IVAL(1)
  1851. IBMN=MIN(IB,VELCHE(/2))
  1852. SECT=VELCHE(1,IBMN)
  1853. MELVAL=IVAL(2)
  1854. IBMN=MIN(IB,VELCHE(/2))
  1855. SCEL=VELCHE(1,IBMN)
  1856. MELVAL=IVAL(3)
  1857. IBMN=MIN(IB,VELCHE(/2))
  1858. SFLU=VELCHE(1,IBMN)
  1859. MELVAL=IVAL(4)
  1860. IBMN=MIN(IB,VELCHE(/2))
  1861. EPS =VELCHE(1,IBMN)
  1862. ELSE
  1863. SECT=1.D0
  1864. MELVAL=IVAL(1)
  1865. IBMN=MIN(IB,VELCHE(/2))
  1866. SCEL=VELCHE(1,IBMN)
  1867. MELVAL=IVAL(2)
  1868. IBMN=MIN(IB,VELCHE(/2))
  1869. SFLU=VELCHE(1,IBMN)
  1870. MELVAL=IVAL(3)
  1871. IBMN=MIN(IB,VELCHE(/2))
  1872. EPS =VELCHE(1,IBMN)
  1873. MELVAL=IVAL(4)
  1874. IBMN=MIN(IB,VELCHE(/2))
  1875. F11 =VELCHE(1,IBMN)
  1876. MELVAL=IVAL(5)
  1877. IBMN=MIN(IB,VELCHE(/2))
  1878. F12 =VELCHE(1,IBMN)
  1879. ENDIF
  1880. c
  1881. c calcul de la masse m0/eps**2
  1882. c
  1883. RHOSS=RHOS*SECT/(EPS*EPS)
  1884. c
  1885. c calcul des coefficients de normalisation
  1886. c
  1887. COEFPR=(RHOREF*CREF*CREF)/RLCAR
  1888. COEFPI=RHOREF*RLCAR
  1889. VKL12 =-(COEFPR*COEFPI*SFLU)/(RHOF*C*C*SCEL)
  1890. VKL22 =-(COEFPI*COEFPI)/(RHOF*SCEL)
  1891. VKL23 = COEFPI/SCEL
  1892. VKL33 = 1.D0/SCEL
  1893. VKL41 = EPS*EPS/2.D0/SCEL*(COEFPR*COEFPI)
  1894. VKL42 = EPS*EPS/2.D0/SCEL*COEFPI*COEFPI
  1895. VKL43 = EPS*EPS/2.D0/SCEL*COEFPI
  1896. VKL44 = EPS*EPS/2.D0/SCEL
  1897. c
  1898. c boucle sur les points de gauss
  1899. c cas plan
  1900. c
  1901. ISDJC=0
  1902. DO 6157 IGAU1=1,NBPGAU
  1903. POIGA1=MINTE.POIGAU(IGAU1)
  1904. CALL TRIHM31(IGAU1,MELE,NBNO,XE,SHPTOT,SHPWRK
  1905. # ,RHOSS,RHOF,
  1906. # B11,B22,B12,F11,F12,SFLU,SCEL,POIGA1,VKL12,VKL22,
  1907. # VKL23,VKL33,VKL42,VKL43,VKL44,E111,E112,E121,E122,
  1908. # E221,E222,LRE,REL,ISDJC,IRRT)
  1909. IF(IRRT.NE.1) GOTO 7092
  1910. 6157 CONTINUE
  1911. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1912. * SEGINI XMATRI
  1913. * IMATTT(IB)=XMATRI
  1914. c
  1915. c remplissage de xmatri
  1916. c
  1917. CALL REMPMT(REL,LRE,RE(1,1,ib))
  1918. * SEGDES XMATRI
  1919. 3157 CONTINUE
  1920. c
  1921. c impression d un eventuel message d erreur
  1922. c
  1923. IF(I195.NE.0) INTERR(1)=I195
  1924. IF(I195.NE.0) CALL ERREUR(195)
  1925. 7157 CONTINUE
  1926. IF(IRRT.EQ.0) THEN
  1927. MOTERR(1:4)=NOMTP(MELE)
  1928. CALL ERREUR(420)
  1929. ELSE
  1930. IF(IRRT.EQ.2) THEN
  1931. INTERR(1) = IB
  1932. CALL ERREUR(405)
  1933. ENDIF
  1934. ENDIF
  1935. IF(IRRT.EQ.3) CALL ERREUR(421)
  1936. IF(IRRT.EQ.4) CALL ERREUR(422)
  1937. SEGDES xMATRI
  1938. SEGSUP WRK1,WRK2,MVELCH
  1939. GOTO 510
  1940. c_______________________________________________________________________
  1941. *
  1942. 99 CONTINUE
  1943. MOTERR(1:4)=NOMTP(MELE)
  1944. MOTERR(5:12)='MASSE4'
  1945. CALL ERREUR(86)
  1946. *
  1947. 510 CONTINUE
  1948. if (CMATE.EQ.'STATIQUE') then
  1949. mlmots = iinc
  1950. if (iinc.gt.0) segsup mlmots
  1951. mlmots = idua
  1952. if (idua.gt.0) segsup mlmots
  1953. endif
  1954. RETURN
  1955. END
  1956.  
  1957.  
  1958.  
  1959.  
  1960.  
  1961.  
  1962.  
  1963.  
  1964.  
  1965.  

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