Télécharger masse4.eso

Retour à la liste

Numérotation des lignes :

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

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