Télécharger sigma2.eso

Retour à la liste

Numérotation des lignes :

  1. C SIGMA2 SOURCE PV 19/01/25 21:15:14 10085
  2. SUBROUTINE SIGMA2(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,
  3. & IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,
  4. & IPMIN1,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,NPINT,IVASTR
  5. & ,UZDPG,RYDPG,RXDPG,IIPDPG,inoer)
  6. *---------------------------------------------------------------------*
  7. * __________________________ *
  8. * | | *
  9. * | calcul des contraintes| *
  10. * |________________________| *
  11. * *
  12. * coq3,dkt,coq4,coq8,coq2 ,dst,joint 3d,joints 2d *
  13. * *
  14. *---------------------------------------------------------------------*
  15. * *
  16. * entrees : *
  17. * ________ *
  18. * *
  19. * ipmail pointeur sur un segment meleme *
  20. * ivadep pointeur sur le chamelem de deplacements *
  21. * ivacar pointeur sur les chamelems de caracteristiques *
  22. * nelmat taille maxi des melval du materiau (no d'element) *
  23. * nbgmat taille maxi des melval du materiau (pt de gauss) *
  24. * ivamat pointeur sur un segment mptval pour le materiau ou *
  25. * lhook dimension de la matrice de hooke *
  26. * imat (2 il y a une matrice de hooke,1 non ) *
  27. * mate numero du materiau *
  28. * cmate nom du materiau *
  29. * nmatt nombre de composante de materiau (imat=1) *
  30. * nstrs nombre de composante de contraintes/deformations *
  31. * pour une matrice de hooke *
  32. * mfr numero de formulation de l'element fini *
  33. * ipmint pointeur sur un segment minte *
  34. * ipmin1 pointeur sur un segment minte (aux noeuds) *
  35. * ndep nombre de composantes de deplacements *
  36. * nbpgau nombre de point d'integration pour la rigidite *
  37. * nbptel nombre de points par element *
  38. * mele numero de l'element fini *
  39. * lre nombre de ddl dans la matrice de rigidite *
  40. * lw dimension du tableau de travail de l'element *
  41. * iresp2 flag pour indiquer si on veut les contraintes *
  42. * de piola-kirchhoff *
  43. * npint nombre de points d'integration dans l'epaisseur
  44. * dans le cas des elements de coque integres
  45. * *
  46. * sorties : *
  47. * ________ *
  48. * *
  49. * ivastr pointeur sur un segment mptval contenant les *
  50. * les melvals de contraints
  51. * *
  52. *---------------------------------------------------------------------*
  53. IMPLICIT INTEGER(I-N)
  54. IMPLICIT REAL*8(A-H,O-Z)
  55. *
  56. -INC CCOPTIO
  57. -INC CCHAMP
  58. -INC CCREEL
  59. -INC SMCHAML
  60. -INC SMINTE
  61. -INC SMELEME
  62. -INC SMCOORD
  63. -INC SMLREEL
  64. *
  65. SEGMENT WRK1
  66. REAL*8 DDHOOK(LHOOK,LHOOK) ,XDDL(LRE) ,XSTRS(NSTRS)
  67. REAL*8 XE(3,NBBB) ,DDHOMU(LHOOK,LHOOK)
  68. ENDSEGMENT
  69. *
  70. SEGMENT WRK2
  71. REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  72. ENDSEGMENT
  73. *
  74. SEGMENT WRK3
  75. REAL*8 WORK(LW)
  76. ENDSEGMENT
  77. *
  78. SEGMENT WRK4
  79. REAL*8 BPSS(3,3) ,XEL(3,NBBB) ,XDDLOC(LRE)
  80. ENDSEGMENT
  81. *
  82. SEGMENT WRK5
  83. REAL*8 XSTRS1(NSTRS1)
  84. ENDSEGMENT
  85. *
  86. SEGMENT,MVELCH
  87. REAL*8 VALMAT(NV1)
  88. ENDSEGMENT
  89. *
  90. SEGMENT MPTVAL
  91. INTEGER IPOS(NS) ,NSOF(NS)
  92. INTEGER IVAL(NCOSOU)
  93. CHARACTER*16 TYVAL(NCOSOU)
  94. ENDSEGMENT
  95. *
  96. CHARACTER*8 CMATE
  97. *
  98. * initialisation du point autour duquel se fait le mouvement
  99. * en deformation plane generalisee
  100. *
  101. IF (IFOUR.EQ.-3) THEN
  102. IP=IIPDPG
  103. SEGACT MCOORD
  104. IREF=(IP-1)*(IDIM+1)
  105. XDPGE=XCOOR(IREF+1)
  106. YDPGE=XCOOR(IREF+2)
  107. ELSE
  108. XDPGE=0.D0
  109. YDPGE=0.D0
  110. ENDIF
  111. *
  112. MELEME=IPMAIL
  113. NBNN=NUM(/1)
  114. NBELEM=NUM(/2)
  115. *
  116. NV1=NMATT
  117. SEGINI,MVELCH
  118. *
  119. NHRM=NIFOUR
  120. *
  121. MINTE=IPMINT
  122. IRTD=1
  123. *
  124. NBBB=NBNN
  125. SEGINI WRK1
  126. c_______________________________________________________________________
  127. c
  128. c numero des etiquettes :
  129. c etiquettes de 1 a 98 pour traitement specifique a l element
  130. c dans la zone specifique a chaque element commencant par :
  131. c 5 continue
  132. c element 5 etiquettes 1005 2005 3005 4005 ...
  133. c 44 continue
  134. c element 44 etiquettes 1044 2044 3044 4044 ...
  135. c_______________________________________________________________________
  136. c
  137. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  138. 1 99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  139. 2 41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  140. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  141. 4 99,99,99,99,85,86,87,88,99,99,99,99,93,99,99,99,99),MELE
  142. *
  143. GOTO(168,169,170,171,172),MELE-167
  144. *
  145. GOTO 99
  146. c_______________________________________________________________________
  147. c
  148. c element coq3
  149. c_______________________________________________________________________
  150. c
  151. 27 CONTINUE
  152. SEGINI WRK3
  153. c
  154. c boucle de calcul pour les differents elements
  155. c
  156. DO 3027 IB=1,NBELEM
  157. c
  158. c on cherche les deplacements
  159. c
  160. MPTVAL=IVADEP
  161. IE=1
  162. DO 4027 IGAU=1,NBNN
  163. DO 4027 ICOMP=1,NDEP
  164. MELVAL=IVAL(ICOMP)
  165. IGMN=MIN(IGAU,VELCHE(/1))
  166. IBMN=MIN(IB ,VELCHE(/2))
  167. XDDL(IE)=VELCHE(IGMN,IBMN)
  168. IE=IE+1
  169. 4027 CONTINUE
  170. c
  171. c on cherche les coordonnees des noeuds de l element ib
  172. c
  173. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  174. c
  175. c on cherche les coeff des mat de hooke et l epaisseur
  176. c
  177. MPTVAL=IVACAR
  178. MELVAL=IVAL(1)
  179. IF (MELVAL.NE.0) THEN
  180. IBMN=MIN(IB,VELCHE(/2))
  181. EPAIST=VELCHE(1,IBMN)
  182. ELSE
  183. EPAIST=0.D0
  184. ENDIF
  185. c
  186. MPTVAL=IVAMAT
  187. IF(IMAT.EQ.2) THEN
  188. IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  189. MELVAL=IVAL(1)
  190. IBMN=MIN(IB ,IELCHE(/2))
  191. MLREEL=IELCHE(1,IBMN)
  192. SEGACT MLREEL
  193. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  194. SEGDES MLREEL
  195. ENDIF
  196. ELSE IF (IMAT.EQ.1) THEN
  197. IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  198. DO 9027 IM=1,NMATT
  199. IF (IVAL(IM).NE.0) THEN
  200. MELVAL=IVAL(IM)
  201. IBMN=MIN(IB ,VELCHE(/2))
  202. VALMAT(IM)=VELCHE(1,IBMN)
  203. ELSE
  204. VALMAT(IM)=0.D0
  205. ENDIF
  206. 9027 CONTINUE
  207. CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  208. ENDIF
  209. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  210. ENDIF
  211. CALL COQ3ST(XE,XDDL,XSTRS,DDHOMU)
  212. c
  213. IF(IREPS2.EQ.1)
  214. 1 CALL DBCO32(XE,DDHOMU,XDDL,WORK,XSTRS)
  215. c
  216. MPTVAL=IVASTR
  217. DO 6027 ICOMP=1,NSTRS
  218. MELVAL=IVAL(ICOMP)
  219. IBMN=MIN(IB,VELCHE(/2))
  220. VELCHE(1,IBMN)=XSTRS(ICOMP)
  221. 6027 CONTINUE
  222. c
  223. 3027 CONTINUE
  224. c
  225. IF(IRTD.EQ.0) THEN
  226. MOTERR(1:8)=CMATE
  227. MOTERR(9:12)=NOMFR(MFR/2+1)
  228. INTERR(1)=IFOUR
  229. CALL ERREUR(81)
  230. ENDIF
  231. 9927 CONTINUE
  232. SEGSUP WRK3
  233. GOTO 510
  234. c____________________________________________________________________
  235. c
  236. c element dkt
  237. c____________________________________________________________________
  238. c
  239. 28 CONTINUE
  240. NBNO=NBNN
  241. SEGINI WRK2,WRK4
  242. IF(NPINT.NE.0)THEN
  243. NSTRS1=6
  244. SEGINI WRK5
  245. ENDIF
  246. DO 3028 IB=1,NBELEM
  247. c
  248. c on cherche les deplacements
  249. c
  250. MPTVAL=IVADEP
  251. IE=1
  252. DO 4028 IGAU=1,NBNN
  253. DO 4028 ICOMP=1,NDEP
  254. MELVAL=IVAL(ICOMP)
  255. IGMN=MIN(IGAU,VELCHE(/1))
  256. IBMN=MIN(IB ,VELCHE(/2))
  257. XDDL(IE)=VELCHE(IGMN,IBMN)
  258. IE=IE+1
  259. 4028 CONTINUE
  260. c
  261. c on cherche les coordonnees des noeuds de l'element ib
  262. c
  263. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  264. CALL VPAST(XE,BPSS)
  265. c bpss stocke la matrice de passage
  266. CALL VCORLC (XE,XEL,BPSS)
  267. CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  268. c
  269. c on cherche les epaiseurs et on les moyenne,
  270. c les excentrements et on les moyenne.
  271. c
  272. EPAIST=0.D0
  273. MPTVAL=IVACAR
  274. MELVAL=IVAL(1)
  275. IF (MELVAL.NE.0) THEN
  276. DO IGAU=1,NBPGAU
  277. IGMN=MIN(IGAU,VELCHE(/1))
  278. IBMN=MIN(IB,VELCHE(/2))
  279. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  280. ENDDO
  281. EPAIST=EPAIST/NBPGAU
  282. ENDIF
  283. *
  284. EXCEN=0.D0
  285. MELVAL=IVAL(2)
  286. IF (MELVAL.NE.0) THEN
  287. DO IGAU=1,NBPGAU
  288. IGMN=MIN(IGAU,VELCHE(/1))
  289. IBMN=MIN(IB,VELCHE(/2))
  290. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  291. ENDDO
  292. EXCEN=EXCEN/NBPGAU
  293. ENDIF
  294. c
  295. IF(NPINT.EQ.0)THEN
  296. c
  297. c coque global
  298. c
  299. c boucle sur les points de gauss
  300. c
  301. DO 5028 IGAU=1,NBPTEL
  302. CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  303. & MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  304. & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  305. *
  306. * on modifie la matrice b en cas d'excentrement non nul
  307. *
  308. IF (EXCEN.NE.0.D0) THEN
  309. DO 1528 IJL=1,3
  310. DO 1528 IJC=1,LRE
  311. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  312. 1528 CONTINUE
  313. ENDIF
  314. c
  315. c on cherche la matrice de hooke
  316. c
  317. MPTVAL=IVAMAT
  318. IF(IMAT.EQ.2) THEN
  319. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  320. MELVAL=IVAL(1)
  321. IBMN=MIN(IB ,IELCHE(/2))
  322. IGMN=MIN(IGAU,IELCHE(/1))
  323. MLREEL=IELCHE(IGMN,IBMN)
  324. SEGACT MLREEL
  325. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  326. SEGDES MLREEL
  327. ENDIF
  328. ELSE IF (IMAT.EQ.1) THEN
  329. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  330. DO 9128 IM=1,NMATT
  331. IF (IVAL(IM).NE.0) THEN
  332. MELVAL=IVAL(IM)
  333. IBMN=MIN(IB ,VELCHE(/2))
  334. IGMN=MIN(IGAU,VELCHE(/1))
  335. VALMAT(IM)=VELCHE(IGMN,IBMN)
  336. ELSE
  337. VALMAT(IM)=0.D0
  338. ENDIF
  339. 9128 CONTINUE
  340. CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  341. ENDIF
  342. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  343. ENDIF
  344. CALL DBST(BGENE,DDHOMU,XDDLOC,LRE,NSTRS,XSTRS)
  345. c
  346. c calcul des eps 2
  347. c
  348. IF(IREPS2.EQ.1)
  349. 1 CALL DBDKT2(XEL,DDHOMU,XDDLOC,IGAU,XSTRS,SHPWRK,SHPTOT,
  350. 1 BGENE,NBNO,LRE,NSTRS)
  351. c
  352. c remplissage du segment contenant les contraintes
  353. c
  354. MPTVAL=IVASTR
  355. DO 9028 ICOMP=1,NSTRS
  356. MELVAL=IVAL(ICOMP)
  357. IBMN=MIN(IB ,VELCHE(/2))
  358. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  359. 9028 CONTINUE
  360. 5028 CONTINUE
  361. c
  362. ELSE
  363. c
  364. c coque integree
  365. c
  366. NBPGA1=NBPGAU/NPINT
  367. c
  368. c boucle sur les points de gauss de la surface
  369. c
  370. DO 5001 IGAU=1,NBPGA1
  371. CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  372. & MELE,MFR,NBNO,LRE,IFOUR,NSTRS1,0,1.D0,XEL,
  373. & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  374. *
  375. * on modifie la matrice b en cas d'excentrement non nul
  376. *
  377. IF (EXCEN.NE.0.D0) THEN
  378. DO 1501 IJL=1,3
  379. DO 1501 IJC=1,LRE
  380. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  381. 1501 CONTINUE
  382. ENDIF
  383. c
  384. c boucle sur les nappes
  385. c
  386. DO 5002 INAP=1,NPINT
  387. IGAU1=(INAP-1)*NBPGA1+IGAU
  388. c
  389. c on cherche la matrice de hooke
  390. c
  391. MPTVAL=IVAMAT
  392. IF(IMAT.EQ.2) THEN
  393. IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  394. MELVAL=IVAL(1)
  395. IBMN=MIN(IB ,IELCHE(/2))
  396. IGMN=MIN(IGAU1,IELCHE(/1))
  397. MLREEL=IELCHE(IGMN,IBMN)
  398. SEGACT MLREEL
  399. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  400. SEGDES MLREEL
  401. ENDIF
  402. ELSE IF (IMAT.EQ.1) THEN
  403. IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  404. DO 9101 IM=1,NMATT
  405. IF (IVAL(IM).NE.0) THEN
  406. MELVAL=IVAL(IM)
  407. IBMN=MIN(IB ,VELCHE(/2))
  408. IGMN=MIN(IGAU1,VELCHE(/1))
  409. VALMAT(IM)=VELCHE(IGMN,IBMN)
  410. ELSE
  411. VALMAT(IM)=0.D0
  412. ENDIF
  413. 9101 CONTINUE
  414. CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  415. ENDIF
  416. ENDIF
  417. CALL DBST(BGENE,DDHOOK,XDDLOC,LRE,NSTRS1,XSTRS1)
  418. c
  419. c calcul des eps 2
  420. c
  421. IF(IREPS2.EQ.1)
  422. 1 CALL DBDKT2(XEL,DDHOOK,XDDLOC,IGAU,XSTRS1,SHPWRK,SHPTOT,
  423. 1 BGENE,NBNO,LRE,NSTRS1)
  424. c
  425. ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  426. XSTRS(1)=XSTRS1(1)+ZZZ*XSTRS1(4)
  427. XSTRS(2)=XSTRS1(2)+ZZZ*XSTRS1(5)
  428. XSTRS(3)=0.D0
  429. XSTRS(4)=XSTRS1(3)+ZZZ*XSTRS1(6)
  430. c
  431. c remplissage du segment contenant les contraintes
  432. c
  433. MPTVAL=IVASTR
  434. DO 9001 ICOMP=1,NSTRS
  435. MELVAL=IVAL(ICOMP)
  436. IBMN=MIN(IB ,VELCHE(/2))
  437. VELCHE(IGAU1,IBMN)=XSTRS(ICOMP)
  438. 9001 CONTINUE
  439. c fin de boucle sur les nappes de points
  440. 5002 CONTINUE
  441. c fin de boucle sur les points dans chaque nappe
  442. 5001 CONTINUE
  443. c fin de boucle sur les points d'integration
  444. ENDIF
  445. c fin de boucle sur les elements
  446. 3028 CONTINUE
  447. *
  448. IF(IRTD.EQ.0) THEN
  449. MOTERR(1:8)=CMATE
  450. MOTERR(9:12)=NOMFR(MFR/2+1)
  451. INTERR(1)=IFOUR
  452. CALL ERREUR(81)
  453. ENDIF
  454. 9928 CONTINUE
  455. SEGSUP,WRK2,WRK4
  456. IF(NPINT.NE.0)SEGSUP WRK5
  457. *
  458. GOTO 510
  459. c____________________________________________________________________
  460. c
  461. c elements coq6 et coq8
  462. c____________________________________________________________________
  463. c
  464. 41 CONTINUE
  465. NBNO=NBNN
  466. SEGINI WRK2,WRK3
  467. MINTE1=IPMIN1
  468. SEGACT MINTE1
  469. NBPGA1=MINTE1.SHPTOT(/3)
  470. NBN1 =MINTE1.SHPTOT(/2)
  471. c
  472. c boucle de calcul pour les differents elements
  473. c
  474. DO 3041 IB=1,NBELEM
  475. c
  476. c on cherche les deplacements
  477. c
  478. MPTVAL=IVADEP
  479. IE=1
  480. DO 4041 IGAU=1,NBNN
  481. DO 4041 ICOMP=1,NDEP
  482. MELVAL=IVAL(ICOMP)
  483. IGMN=MIN(IGAU,VELCHE(/1))
  484. IBMN=MIN(IB ,VELCHE(/2))
  485. XDDL(IE)=VELCHE(IGMN,IBMN)
  486. IE=IE+1
  487. 4041 CONTINUE
  488. c
  489. c on cherche les coordonnees des noeuds de l'element ib
  490. c
  491. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  492. c
  493. c on cherche les epaisseurs et les excentrements,
  494. c
  495. MPTVAL=IVACAR
  496. MELVAL=IVAL(1)
  497. IF (MELVAL.NE.0) THEN
  498. DO IGAU=1,NBPGAU
  499. IGMN=MIN(IGAU,VELCHE(/1))
  500. IBMN=MIN(IB,VELCHE(/2))
  501. WORK(IGAU)=VELCHE(IGMN,IBMN)
  502. ENDDO
  503. ENDIF
  504. *
  505. MELVAL=IVAL(2)
  506. IF (MELVAL.NE.0) THEN
  507. DO IGAU=1,NBPGAU
  508. IGMN=MIN(IGAU,VELCHE(/1))
  509. IBMN=MIN(IB,VELCHE(/2))
  510. WORK(IGAU+10)=VELCHE(IGMN,IBMN)
  511. ENDDO
  512. ENDIF
  513. c
  514. c determination des axes locaux aux noeuds
  515. c
  516. CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  517. c
  518. c boucle sur les points de gauss
  519. c
  520. DO 3042 IGAU=1,NBPTEL
  521. c
  522. c calcul de la matrice b
  523. c
  524. E3=DZEGAU(IGAU)
  525. CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  526. 1 E3,SHPTOT,WORK(21),IRR)
  527. c
  528. IF (IRR.EQ.0) THEN
  529. INTERR(1)=IB
  530. CALL ERREUR(241)
  531. GOTO 9941
  532. ELSE IF (IRR.EQ.-1) THEN
  533. INTERR(1)=IB
  534. CALL ERREUR(240)
  535. GOTO 9941
  536. ENDIF
  537. c
  538. c on cherche les coeff des mat de hooke
  539. c
  540. MPTVAL=IVAMAT
  541. IF(IMAT.EQ.2) THEN
  542. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  543. MELVAL=IVAL(1)
  544. IBMN=MIN(IB ,IELCHE(/2))
  545. IGMN=MIN(IGAU,IELCHE(/1))
  546. MLREEL=IELCHE(IGMN,IBMN)
  547. SEGACT MLREEL
  548. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  549. SEGDES MLREEL
  550. ENDIF
  551. ELSE IF (IMAT.EQ.1) THEN
  552. DO 9041 IM=1,NMATT
  553. IF (IVAL(IM).NE.0) THEN
  554. MELVAL=IVAL(IM)
  555. IBMN=MIN(IB ,VELCHE(/2))
  556. IGMN=MIN(IGAU,VELCHE(/1))
  557. VALMAT(IM)=VELCHE(IGMN,IBMN)
  558. ELSE
  559. VALMAT(IM)=0.D0
  560. ENDIF
  561. 9041 CONTINUE
  562. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  563. 1 CALL DOHCOE(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  564. ENDIF
  565. c
  566. c on calcule les contraintes pour le point de gauss
  567. c
  568. CALL DBST (BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS )
  569. c
  570. c on remplit les contraintes
  571. c
  572. MPTVAL=IVASTR
  573. DO 6041 ICOMP=1,NSTRS
  574. MELVAL=IVAL(ICOMP)
  575. IBMN=MIN(IB ,VELCHE(/2))
  576. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  577. 6041 CONTINUE
  578. c
  579. 3042 CONTINUE
  580. c
  581. 3041 CONTINUE
  582.  
  583. IF (IRTD.EQ.0) THEN
  584. MOTERR(1:8)=CMATE
  585. MOTERR(9:12)=NOMFR(MFR/2+1)
  586. INTERR(1)=IFOUR
  587. CALL ERREUR(81)
  588. ENDIF
  589. 9941 CONTINUE
  590. SEGSUP,WRK2,WRK3
  591. SEGDES MINTE1
  592. GOTO 510
  593. c____________________________________________________________________
  594. c
  595. c element coq2
  596. c____________________________________________________________________
  597. c
  598. 44 CONTINUE
  599. NBNO=NBNN
  600. SEGINI WRK2
  601.  
  602. NDDD=NDEP
  603. IF (IFOUR.EQ.-3) NDDD=NDEP-3
  604.  
  605. DO 3044 IB=1,NBELEM
  606. c
  607. c on cherche les deplacements
  608. c
  609. MPTVAL=IVADEP
  610. IE=1
  611. DO 5044 IGAU=1,NBNN
  612. DO 5044 ICOMP=1,NDDD
  613. MELVAL=IVAL(ICOMP)
  614. IGMN=MIN(IGAU,VELCHE(/1))
  615. IBMN=MIN(IB ,VELCHE(/2))
  616. XDDL(IE)=VELCHE(IGMN,IBMN)
  617. IE=IE+1
  618. 5044 CONTINUE
  619. IF (IFOUR.EQ.-3) THEN
  620. XDDL(IE)=UZDPG
  621. XDDL(IE+1)=RYDPG
  622. XDDL(IE+2)=RXDPG
  623. ENDIF
  624. c
  625. c on cherche les coordonnees des noeuds de l'element ib
  626. c
  627. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  628. c
  629. c on cherche les epaisseurs et les excentrements,
  630. c on les moyenne sur l'element.
  631. c
  632. EPAIST=0.D0
  633. MPTVAL=IVACAR
  634. MELVAL=IVAL(1)
  635. IF (MELVAL.NE.0) THEN
  636. DO IGAU=1,NBPGAU
  637. IGMN=MIN(IGAU,VELCHE(/1))
  638. IBMN=MIN(IB,VELCHE(/2))
  639. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  640. ENDDO
  641. EPAIST=EPAIST/NBPGAU
  642. ENDIF
  643. *
  644. EXCEN=0.D0
  645. MELVAL=IVAL(2)
  646. IF (MELVAL.NE.0) THEN
  647. DO IGAU=1,NBPGAU
  648. IGMN=MIN(IGAU,VELCHE(/1))
  649. IBMN=MIN(IB,VELCHE(/2))
  650. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  651. ENDDO
  652. EXCEN=EXCEN/NBPGAU
  653. ENDIF
  654. c
  655. c boucle sur les points de gauss
  656. c
  657. DO 4044 IGAU=1,NBPGAU
  658. c
  659. c appel a bcoq2
  660. c
  661. CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  662. . EXCEN,1.D0,IRR,XDPGE,YDPGE)
  663. c
  664. c gestion d'erreur
  665. c
  666. IF (IRR.EQ.1) THEN
  667. INTERR(1)=IB
  668. CALL ERREUR(255)
  669. GOTO 9944
  670. ELSE IF (IRR.EQ.2) THEN
  671. INTERR(1)=IB
  672. CALL ERREUR(256)
  673. GOTO 9944
  674. ENDIF
  675. c
  676. c matrice de hooke
  677. c
  678. MPTVAL=IVAMAT
  679. IF(IMAT.EQ.2) THEN
  680. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  681. MELVAL=IVAL(1)
  682. IBMN=MIN(IB ,IELCHE(/2))
  683. MLREEL=IELCHE(1,IBMN)
  684. SEGACT MLREEL
  685. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  686. SEGDES MLREEL
  687. ENDIF
  688. ELSE IF (IMAT.EQ.1) THEN
  689. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  690. DO 1044 IM=1,NMATT
  691. IF (IVAL(IM).NE.0) THEN
  692. MELVAL=IVAL(IM)
  693. IBMN=MIN(IB ,VELCHE(/2))
  694. VALMAT(IM)=VELCHE(1,IBMN)
  695. ELSE
  696. VALMAT(IM)=0.D0
  697. ENDIF
  698. 1044 CONTINUE
  699. CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  700. ENDIF
  701. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  702. ENDIF
  703. c
  704. c on va séparer l'appel à DBST en 3 parties :
  705. c - multiplication de B * DDL
  706. c - rajout éventuel de termes quadratiques
  707. c - multiplication des deformations par la matrice de Hooke
  708. c
  709. c CALL DBST(BGENE,DDHOMU,XDDL,LRE,NSTRS,XSTRS)
  710. c
  711. CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  712.  
  713. IF(IREPS2.EQ.1)
  714. +call b2coq2(xstrs,nstrs,xddl,nbnn*ndep,xe,nbnn,QSIGAU,POIGAU,igau)
  715.  
  716. call dxdefo(ddhomu,nstrs,xstrs)
  717. c
  718. c remplissage du segment contenant les contraintes
  719. c
  720. MPTVAL=IVASTR
  721. DO 9044 ICOMP=1,NSTRS
  722. MELVAL=IVAL(ICOMP)
  723. IGMN=MIN(IGAU,VELCHE(/1))
  724. IBMN=MIN(IB ,VELCHE(/2))
  725. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  726. 9044 CONTINUE
  727. 4044 CONTINUE
  728. 3044 CONTINUE
  729. c
  730. IF (IRTD.EQ.0) THEN
  731. MOTERR(1:8)=CMATE
  732. MOTERR(9:12)=NOMFR(MFR/2+1)
  733. INTERR(1)=IFOUR
  734. CALL ERREUR(81)
  735. ENDIF
  736. 9944 CONTINUE
  737. SEGSUP,WRK2
  738. GOTO 510
  739. c____________________________________________________________________
  740. c
  741. c element coq4
  742. c____________________________________________________________________
  743. c
  744. 49 CONTINUE
  745. NBNO=NBNN
  746. SEGINI WRK2,WRK4
  747. DO 3049 IB=1,NBELEM
  748. c
  749. c on cherche les deplacements
  750. c
  751. MPTVAL=IVADEP
  752. IE=1
  753. DO 5049 IGAU=1,NBNN
  754. DO 5049 ICOMP=1,NDEP
  755. MELVAL=IVAL(ICOMP)
  756. IGMN=MIN(IGAU,VELCHE(/1))
  757. IBMN=MIN(IB ,VELCHE(/2))
  758. XDDL(IE)=VELCHE(IGMN,IBMN)
  759. IE=IE+1
  760. 5049 CONTINUE
  761. c
  762. c on cherche les coordonnees des noeuds de l'element ib
  763. c
  764. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  765. c
  766. CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  767. c iert=1 nodi troppo vicini
  768. IF (IERT.EQ.1) THEN
  769. INTERR(1)=IB
  770. CALL ERREUR(323)
  771. GOTO 9949
  772. ELSE IF (IERT.EQ.3) THEN
  773. IERT = 0
  774. NOPLAN = 1
  775. ELSE
  776. NOPLAN = 0
  777. ENDIF
  778. CALL MATVEC(XDDL,XDDLOC,BPSS,8)
  779. c
  780. c on cherche les epaisseurs et les excentrements,
  781. c on les moyenne sur l'element.
  782. c
  783. MPTVAL=IVACAR
  784. EPAIST=0.D0
  785. MELVAL=IVAL(1)
  786. IF (MELVAL.NE.0) THEN
  787. DO IGAU=1,NBPGAU
  788. IGMN=MIN(IGAU,VELCHE(/1))
  789. IBMN=MIN(IB,VELCHE(/2))
  790. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  791. ENDDO
  792. EPAIST=EPAIST/NBPGAU
  793. ENDIF
  794. *
  795. EXCEN=0.D0
  796. MELVAL=IVAL(2)
  797. IF (MELVAL.NE.0) THEN
  798. DO IGAU=1,NBPGAU
  799. IGMN=MIN(IGAU,VELCHE(/1))
  800. IBMN=MIN(IB,VELCHE(/2))
  801. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  802. ENDDO
  803. EXCEN=EXCEN/NBPGAU
  804. ENDIF
  805. c
  806. c boucle sur les points de gauss
  807. c
  808. DO 4049 IGAU=1,NBPGAU
  809. c
  810. c appel a bcoq4
  811. c
  812. if(cmate.eq.'ISOTROPE') then
  813. CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  814. else
  815. CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  816. endif
  817. c iert=1 jacobiano <= 0
  818. IF (IERT.EQ.1) THEN
  819. INTERR(1)=IB
  820. CALL ERREUR(321)
  821. GOTO 9949
  822. ENDIF
  823. c
  824. c matrice de hooke
  825. c
  826. MPTVAL=IVAMAT
  827. IF(IMAT.EQ.2) THEN
  828. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  829. MELVAL=IVAL(1)
  830. IBMN=MIN(IB ,IELCHE(/2))
  831. MLREEL=IELCHE(1,IBMN)
  832. SEGACT MLREEL
  833. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  834. SEGDES MLREEL
  835. ENDIF
  836. ELSE IF (IMAT.EQ.1) THEN
  837. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  838. DO 1049 IM=1,NMATT
  839. IF (IVAL(IM).NE.0) THEN
  840. MELVAL=IVAL(IM)
  841. IBMN=MIN(IB ,VELCHE(/2))
  842. VALMAT(IM)=VELCHE(1,IBMN)
  843. ELSE
  844. VALMAT(IM)=0.D0
  845. ENDIF
  846. 1049 CONTINUE
  847. CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  848. ENDIF
  849. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  850. ENDIF
  851. c
  852. CALL DBST(BGENE,DDHOMU,XDDLOC,LRE,NSTRS,XSTRS)
  853. c
  854. c remplissage du segment contenant les contraintes
  855. c
  856. MPTVAL=IVASTR
  857. DO 9049 ICOMP=1,NSTRS
  858. MELVAL=IVAL(ICOMP)
  859. IGMN=MIN(IGAU,VELCHE(/1))
  860. IBMN=MIN(IB ,VELCHE(/2))
  861. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  862. 9049 CONTINUE
  863. 4049 CONTINUE
  864. 3049 CONTINUE
  865. c
  866. IF(IRTD.EQ.0) THEN
  867. MOTERR(1:8)=CMATE
  868. MOTERR(9:12)=NOMFR(MFR/2+1)
  869. INTERR(1)=IFOUR
  870. CALL ERREUR(81)
  871. ENDIF
  872. 9949 CONTINUE
  873. SEGSUP,WRK2,WRK4
  874. GOTO 510
  875. c____________________________________________________________________
  876. c
  877. c element joint joi2
  878. c____________________________________________________________________
  879. c
  880. 85 CONTINUE
  881. NBNO=NBNN
  882. SEGINI WRK2,WRK4
  883. c
  884. DO 3085 IB=1,NBELEM
  885. c
  886. c on cherche les deplacements
  887. c
  888. MPTVAL=IVADEP
  889. IE=1
  890. DO 5085 IGAU=1,NBNN
  891. DO 5085 ICOMP=1,NDEP
  892. MELVAL=IVAL(ICOMP)
  893. IGMN=MIN(IGAU,VELCHE(/1))
  894. IBMN=MIN(IB ,VELCHE(/2))
  895. XDDL(IE)=VELCHE(IGMN,IBMN)
  896. IE=IE+1
  897. 5085 CONTINUE
  898. c
  899. c on cherche les coordonnees des noeuds de l'element ib
  900. c
  901. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  902. c
  903. CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  904. c
  905. c-----------------------------------------------------------------
  906. c je n'ai pas besoin de transformer les deplacements
  907. c dans le repere local car la matrice b est un operateur qui
  908. c s'applique sur une quantite globale, u, pour donner une
  909. c quantite locale, epsilon ; ceci, du fait de la presence
  910. c de la matrice teta dans l'expression de b. si cela est vrai,
  911. c alors il n'est pas necessaire d'appeler matvec.
  912. c il faudra simplement appeler dbst avec xddl et non pas avec
  913. c xddloc.
  914. c-----------------------------------------------------------------
  915. ccccccccc call matvec(xddl,xddloc,bpss,8)
  916. c
  917. c boucle sur les points de gauss
  918. c
  919. DO 4085 IGAU=1,NBPGAU
  920. c
  921. c appel a bjo2 pour le calcul de b
  922. c
  923. CALL BJO2(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  924. . BGENE,DJAC,IRRT)
  925. c irrt=1 jacobien <= 0
  926. IF (IRRT.NE.0) THEN
  927. INTERR(1)=IB
  928. CALL ERREUR(612)
  929. GOTO 9985
  930. ENDIF
  931. c
  932. c matrice de hooke
  933. c
  934. MPTVAL=IVAMAT
  935. IF(IMAT.EQ.2) THEN
  936. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  937. MELVAL=IVAL(1)
  938. IBMN=MIN(IB ,IELCHE(/2))
  939. MLREEL=IELCHE(1,IBMN)
  940. SEGACT MLREEL
  941. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  942. SEGDES MLREEL
  943. ENDIF
  944. ELSE IF (IMAT.EQ.1) THEN
  945. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  946. DO 1085 IM=1,NMATT
  947. IF (IVAL(IM).NE.0) THEN
  948. MELVAL=IVAL(IM)
  949. IBMN=MIN(IB ,VELCHE(/2))
  950. VALMAT(IM)=VELCHE(1,IBMN)
  951. ELSE
  952. VALMAT(IM)=0.D0
  953. ENDIF
  954. 1085 CONTINUE
  955. CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  956. ENDIF
  957. ENDIF
  958. c
  959. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  960. c
  961. c remplissage du segment contenant les contraintes
  962. c
  963. MPTVAL=IVASTR
  964. DO 9085 ICOMP=1,NSTRS
  965. MELVAL=IVAL(ICOMP)
  966. IGMN=MIN(IGAU,VELCHE(/1))
  967. IBMN=MIN(IB ,VELCHE(/2))
  968. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  969. 9085 CONTINUE
  970. 4085 CONTINUE
  971. 3085 CONTINUE
  972. c
  973. IF(IRTD.EQ.0) THEN
  974. MOTERR(1:8)=CMATE
  975. MOTERR(9:12)=NOMFR(MFR/2+1)
  976. INTERR(1)=IFOUR
  977. CALL ERREUR(81)
  978. ENDIF
  979. 9985 CONTINUE
  980. SEGSUP,WRK2,WRK4
  981. GOTO 510
  982. c____________________________________________________________________
  983. c
  984. c element joint jgi2
  985. c____________________________________________________________________
  986. c
  987. 170 CONTINUE
  988. NBNO=NBNN
  989. SEGINI WRK2,WRK4
  990.  
  991. NDDD=NDEP
  992. IF (IFOUR.EQ.-3) NDDD=NDEP-3
  993.  
  994. EPAIST=0.D0
  995.  
  996. DO IB=1,NBELEM
  997. c
  998. c on cherche les deplacements
  999. c
  1000. MPTVAL=IVADEP
  1001. IE=1
  1002. DO IGAU=1,NBNN
  1003. DO ICOMP=1,NDDD
  1004. MELVAL=IVAL(ICOMP)
  1005. IGMN=MIN(IGAU,VELCHE(/1))
  1006. IBMN=MIN(IB ,VELCHE(/2))
  1007. XDDL(IE)=VELCHE(IGMN,IBMN)
  1008. IE=IE+1
  1009. ENDDO
  1010. ENDDO
  1011. IF (IFOUR.EQ.-3) THEN
  1012. XDDL(IE)=UZDPG
  1013. XDDL(IE+1)=RYDPG
  1014. XDDL(IE+2)=RXDPG
  1015. ENDIF
  1016. c
  1017. c on cherche les coordonnees des noeuds de l'element ib
  1018. c
  1019. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1020. c
  1021. CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1022. c
  1023. c boucle sur les points de gauss
  1024. c
  1025. DO IGAU=1,NBPGAU
  1026. c
  1027. c on cherche l'epaisseur du joint
  1028. c
  1029. MPTVAL=IVACAR
  1030. MELVAL=IVAL(1)
  1031. IF (MELVAL.NE.0) THEN
  1032. IGMN=MIN(IGAU,VELCHE(/1))
  1033. IBMN=MIN(IB,VELCHE(/2))
  1034. EPAIST=VELCHE(IGMN,IBMN)
  1035. ENDIF
  1036. c
  1037. c appel a bjo2 pour le calcul de b
  1038. c
  1039. CcPPj CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1040. CcPPj. EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  1041. CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  1042. . EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  1043. c irrt=1 jacobien <= 0
  1044. IF(IRRT.NE.0) THEN
  1045. INTERR(1)=IB
  1046. CALL ERREUR(612)
  1047. GOTO 9970
  1048. ENDIF
  1049. c
  1050. c matrice de hooke
  1051. c
  1052. MPTVAL=IVAMAT
  1053. IF(IMAT.EQ.2) THEN
  1054. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1055. MELVAL=IVAL(1)
  1056. IBMN=MIN(IB ,IELCHE(/2))
  1057. MLREEL=IELCHE(1,IBMN)
  1058. SEGACT MLREEL
  1059. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1060. SEGDES MLREEL
  1061. ENDIF
  1062. ELSE IF (IMAT.EQ.1) THEN
  1063. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1064. DO IM=1,NMATT
  1065. IF (IVAL(IM).NE.0) THEN
  1066. MELVAL=IVAL(IM)
  1067. IBMN=MIN(IB ,VELCHE(/2))
  1068. VALMAT(IM)=VELCHE(1,IBMN)
  1069. ELSE
  1070. VALMAT(IM)=0.D0
  1071. ENDIF
  1072. ENDDO
  1073. CALL DOGO88(VALMAT,CMATE,EPAIST,IFOUR,LHOOK,DDHOOK,IRTD)
  1074. ENDIF
  1075. ENDIF
  1076. c
  1077. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1078. c
  1079. c remplissage du segment contenant les contraintes
  1080. c
  1081. MPTVAL=IVASTR
  1082. DO ICOMP=1,NSTRS
  1083. MELVAL=IVAL(ICOMP)
  1084. IGMN=MIN(IGAU,VELCHE(/1))
  1085. IBMN=MIN(IB ,VELCHE(/2))
  1086. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1087. ENDDO
  1088. ENDDO
  1089. ENDDO
  1090. c
  1091. IF(IRTD.EQ.0) THEN
  1092. MOTERR(1:8)=CMATE
  1093. MOTERR(9:12)=NOMFR(MFR/2+1)
  1094. INTERR(1)=IFOUR
  1095. CALL ERREUR(81)
  1096. ENDIF
  1097. 9970 CONTINUE
  1098. SEGSUP,WRK2,WRK4
  1099. GOTO 510
  1100. c____________________________________________________________________
  1101. c
  1102. c element joint jct3 Pour le moment en 2D cisaillement
  1103. c____________________________________________________________________
  1104. c
  1105. 168 CONTINUE
  1106. NBNO=NBNN
  1107. SEGINI WRK2,WRK4
  1108. IF(CMATE.NE.'ISOTROPE')THEN
  1109. MPTVAL=IVAMAT
  1110. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1111. MELVAL=IVAL(4)
  1112. ELSE
  1113. MELVAL=IVAL(2)
  1114. ENDIF
  1115. NBGCOS=VELCHE(/1)
  1116. ENDIF
  1117.  
  1118. DO IB=1,NBELEM
  1119. c
  1120. c on cherche les deplacements
  1121. c
  1122. MPTVAL=IVADEP
  1123. IE=1
  1124. DO IGAU=1,NBNN
  1125. DO ICOMP=1,NDEP
  1126. MELVAL=IVAL(ICOMP)
  1127. IGMN=MIN(IGAU,VELCHE(/1))
  1128. IBMN=MIN(IB ,VELCHE(/2))
  1129. XDDL(IE)=VELCHE(IGMN,IBMN)
  1130. IE=IE+1
  1131. ENDDO
  1132. ENDDO
  1133. c
  1134. c on cherche les coordonnees des noeuds de l'element ib
  1135. c
  1136. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1137. c
  1138. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1139. c
  1140. c boucle sur les points de gauss
  1141. c
  1142. DO IGAU=1,NBPGAU
  1143. c
  1144. c appel a bjt3 pour le calcul de b
  1145. c
  1146. CALL BJT3C(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1147. . BGENE,DJAC,IRRT)
  1148. c irrt=1 jacobien <= 0
  1149. IF(IRRT.NE.0) THEN
  1150. INTERR(1)=IB
  1151. CALL ERREUR(611)
  1152. GOTO 9968
  1153. ENDIF
  1154. c
  1155. c matrice de hooke
  1156. c
  1157. MPTVAL=IVAMAT
  1158. IF(IMAT.EQ.2) THEN
  1159. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1160. MELVAL=IVAL(1)
  1161. IBMN=MIN(IB ,IELCHE(/2))
  1162. MLREEL=IELCHE(1,IBMN)
  1163. SEGACT MLREEL
  1164. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1165. SEGDES MLREEL
  1166. ENDIF
  1167. ELSE IF (IMAT.EQ.1) THEN
  1168. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1169. DO IM=1,NMATT
  1170. IF (IVAL(IM).NE.0) THEN
  1171. MELVAL=IVAL(IM)
  1172. IBMN=MIN(IB ,VELCHE(/2))
  1173. VALMAT(IM)=VELCHE(1,IBMN)
  1174. ELSE
  1175. VALMAT(IM)=0.D0
  1176. ENDIF
  1177. ENDDO
  1178. CALL DOCO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1179. ENDIF
  1180. ENDIF
  1181. c
  1182. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1183. c
  1184. c remplissage du segment contenant les contraintes
  1185. c
  1186. MPTVAL=IVASTR
  1187. DO ICOMP=1,NSTRS
  1188. MELVAL=IVAL(ICOMP)
  1189. IGMN=MIN(IGAU,VELCHE(/1))
  1190. IBMN=MIN(IB ,VELCHE(/2))
  1191. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1192. ENDDO
  1193. ENDDO
  1194. ENDDO
  1195. c
  1196. IF(IRTD.EQ.0) THEN
  1197. MOTERR(1:8)=CMATE
  1198. MOTERR(9:12)=NOMFR(MFR/2+1)
  1199. INTERR(1)=IFOUR
  1200. CALL ERREUR(81)
  1201. ENDIF
  1202. 9968 CONTINUE
  1203. SEGSUP,WRK2,WRK4
  1204. GOTO 510
  1205. c____________________________________________________________________
  1206. c
  1207. c element de joint generalise jgt3
  1208. c____________________________________________________________________
  1209. c
  1210. 171 CONTINUE
  1211. NBNO=NBNN
  1212. SEGINI WRK2,WRK4
  1213. IF(CMATE.NE.'ISOTROPE')THEN
  1214. MPTVAL=IVAMAT
  1215. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1216. MELVAL=IVAL(4)
  1217. ELSE
  1218. MELVAL=IVAL(2)
  1219. ENDIF
  1220. NBGCOS=VELCHE(/1)
  1221. ENDIF
  1222.  
  1223. DO IB=1,NBELEM
  1224. c
  1225. c on cherche les deplacements
  1226. c
  1227. MPTVAL=IVADEP
  1228. IE=1
  1229. DO IGAU=1,NBNN
  1230. DO ICOMP=1,NDEP
  1231. MELVAL=IVAL(ICOMP)
  1232. IGMN=MIN(IGAU,VELCHE(/1))
  1233. IBMN=MIN(IB ,VELCHE(/2))
  1234. XDDL(IE)=VELCHE(IGMN,IBMN)
  1235. IE=IE+1
  1236. ENDDO
  1237. ENDDO
  1238. c
  1239. c on cherche les coordonnees des noeuds de l'element ib
  1240. c
  1241. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1242. c
  1243. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1244. c
  1245. c boucle sur les points de gauss
  1246. c
  1247. DO IGAU=1,NBPGAU
  1248. c
  1249. c on cherche l'epaissuer du joint
  1250. c
  1251. EPAIST=0.D0
  1252. MPTVAL=IVACAR
  1253. MELVAL=IVAL(1)
  1254. IF (MELVAL.NE.0) THEN
  1255. IGMN=MIN(IGAU,VELCHE(/1))
  1256. IBMN=MIN(IB,VELCHE(/2))
  1257. EPAIST=VELCHE(IGMN,IBMN)
  1258. ENDIF
  1259. c
  1260. c appel a bjt3 pour le calcul de b
  1261. c
  1262. CcPPj CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1263. CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  1264. . EPAIST,BGENE,DJAC,IRRT)
  1265. c irrt=1 jacobien <= 0
  1266. IF (IRRT.NE.0) THEN
  1267. INTERR(1)=IB
  1268. CALL ERREUR(611)
  1269. GOTO 9971
  1270. ENDIF
  1271. c
  1272. c matrice de hooke
  1273. c
  1274. MPTVAL=IVAMAT
  1275. IF(IMAT.EQ.2) THEN
  1276. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1277. MELVAL=IVAL(1)
  1278. IBMN=MIN(IB ,IELCHE(/2))
  1279. MLREEL=IELCHE(1,IBMN)
  1280. SEGACT MLREEL
  1281. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1282. SEGDES MLREEL
  1283. ENDIF
  1284. ELSE IF (IMAT.EQ.1) THEN
  1285. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1286. DO IM=1,NMATT
  1287. IF (IVAL(IM).NE.0) THEN
  1288. MELVAL=IVAL(IM)
  1289. IBMN=MIN(IB ,VELCHE(/2))
  1290. VALMAT(IM)=VELCHE(1,IBMN)
  1291. ELSE
  1292. VALMAT(IM)=0.D0
  1293. ENDIF
  1294. ENDDO
  1295. CALL DOGO88(VALMAT,CMATE,EPAIST,IFOUR,LHOOK,DDHOOK,IRTD)
  1296. ENDIF
  1297. ENDIF
  1298. c
  1299. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1300. c
  1301. c remplissage du segment contenant les contraintes
  1302. c
  1303. MPTVAL=IVASTR
  1304. DO ICOMP=1,NSTRS
  1305. MELVAL=IVAL(ICOMP)
  1306. IGMN=MIN(IGAU,VELCHE(/1))
  1307. IBMN=MIN(IB ,VELCHE(/2))
  1308. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1309. ENDDO
  1310. ENDDO
  1311. ENDDO
  1312. c
  1313. IF(IRTD.EQ.0) THEN
  1314. MOTERR(1:8)=CMATE
  1315. MOTERR(9:12)=NOMFR(MFR/2+1)
  1316. INTERR(1)=IFOUR
  1317. CALL ERREUR(81)
  1318. ENDIF
  1319. 9971 CONTINUE
  1320. SEGSUP,WRK2,WRK4
  1321. GOTO 510
  1322. c____________________________________________________________________
  1323. c
  1324. c element joint jgi4 Pour le moment en 2D cisaillement
  1325. c____________________________________________________________________
  1326. c
  1327. 169 CONTINUE
  1328. NBNO=NBNN
  1329. SEGINI WRK2,WRK4
  1330. IF(CMATE.NE.'ISOTROPE')THEN
  1331. MPTVAL=IVAMAT
  1332. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1333. MELVAL=IVAL(4)
  1334. ELSE
  1335. MELVAL=IVAL(2)
  1336. ENDIF
  1337. NBGCOS=VELCHE(/1)
  1338. ENDIF
  1339. c
  1340. DO IB=1,NBELEM
  1341. c
  1342. c on cherche les deplacements
  1343. c
  1344. MPTVAL=IVADEP
  1345. IE=1
  1346. DO IGAU=1,NBNN
  1347. DO ICOMP=1,NDEP
  1348. MELVAL=IVAL(ICOMP)
  1349. IGMN=MIN(IGAU,VELCHE(/1))
  1350. IBMN=MIN(IB ,VELCHE(/2))
  1351. XDDL(IE)=VELCHE(IGMN,IBMN)
  1352. IE=IE+1
  1353. ENDDO
  1354. ENDDO
  1355. c
  1356. c on cherche les coordonnees des noeuds de l'element ib
  1357. c
  1358. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1359. c
  1360. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1361. c
  1362. c boucle sur les points de gauss
  1363. c
  1364. DO IGAU=1,NBPGAU
  1365. c
  1366. c appel a bjo4 pour le calcul de b
  1367. c
  1368. CALL BJO4C(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1369. c irrt=1 jacobien <= 0
  1370. IF (IRRT.NE.0) THEN
  1371. INTERR(1)=IB
  1372. CALL ERREUR(611)
  1373. GOTO 9969
  1374. ENDIF
  1375. c
  1376. c matrice de hooke
  1377. c
  1378. MPTVAL=IVAMAT
  1379. IF(IMAT.EQ.2) THEN
  1380. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1381. MELVAL=IVAL(1)
  1382. IBMN=MIN(IB ,IELCHE(/2))
  1383. MLREEL=IELCHE(1,IBMN)
  1384. SEGACT MLREEL
  1385. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1386. SEGDES MLREEL
  1387. ENDIF
  1388. ELSE IF (IMAT.EQ.1) THEN
  1389. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1390. DO IM=1,NMATT
  1391. IF (IVAL(IM).NE.0) THEN
  1392. MELVAL=IVAL(IM)
  1393. IBMN=MIN(IB ,VELCHE(/2))
  1394. VALMAT(IM)=VELCHE(1,IBMN)
  1395. ELSE
  1396. VALMAT(IM)=0.D0
  1397. ENDIF
  1398. ENDDO
  1399. CALL DOCO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1400. ENDIF
  1401. ENDIF
  1402. c
  1403. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1404. c
  1405. c remplissage du segment contenant les contraintes
  1406. c
  1407. MPTVAL=IVASTR
  1408. DO ICOMP=1,NSTRS
  1409. MELVAL=IVAL(ICOMP)
  1410. IGMN=MIN(IGAU,VELCHE(/1))
  1411. IBMN=MIN(IB ,VELCHE(/2))
  1412. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1413. ENDDO
  1414. ENDDO
  1415. ENDDO
  1416. c
  1417. IF(IRTD.EQ.0) THEN
  1418. MOTERR(1:8)=CMATE
  1419. MOTERR(9:12)=NOMFR(MFR/2+1)
  1420. INTERR(1)=IFOUR
  1421. CALL ERREUR(81)
  1422. ENDIF
  1423. 9969 CONTINUE
  1424. SEGSUP,WRK2,WRK4
  1425. GOTO 510
  1426. c____________________________________________________________________
  1427. c
  1428. c element joint jgi4 Pour le moment en 2D cisaillement
  1429. c____________________________________________________________________
  1430. c
  1431. 172 CONTINUE
  1432. NBNO=NBNN
  1433. SEGINI WRK2,WRK4
  1434. IF(CMATE.NE.'ISOTROPE')THEN
  1435. MPTVAL=IVAMAT
  1436. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1437. MELVAL=IVAL(4)
  1438. ELSE
  1439. MELVAL=IVAL(2)
  1440. ENDIF
  1441. NBGCOS=VELCHE(/1)
  1442. ENDIF
  1443. c
  1444. DO IB=1,NBELEM
  1445. c
  1446. c on cherche les deplacements
  1447. c
  1448. MPTVAL=IVADEP
  1449. IE=1
  1450. DO IGAU=1,NBNN
  1451. DO ICOMP=1,NDEP
  1452. MELVAL=IVAL(ICOMP)
  1453. IGMN=MIN(IGAU,VELCHE(/1))
  1454. IBMN=MIN(IB ,VELCHE(/2))
  1455. XDDL(IE)=VELCHE(IGMN,IBMN)
  1456. IE=IE+1
  1457. ENDDO
  1458. ENDDO
  1459. c
  1460. c on cherche les coordonnees des noeuds de l'element ib
  1461. c
  1462. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1463. c
  1464. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1465. c
  1466. c boucle sur les points de gauss
  1467. c
  1468. DO IGAU=1,NBPGAU
  1469. c
  1470. c on cherche l'epaissuer du joint
  1471. c
  1472. EPAIST=0.D0
  1473. MPTVAL=IVACAR
  1474. MELVAL=IVAL(1)
  1475. IF (MELVAL.NE.0) THEN
  1476. IGMN=MIN(IGAU,VELCHE(/1))
  1477. IBMN=MIN(IB,VELCHE(/2))
  1478. EPAIST=VELCHE(IGMN,IBMN)
  1479. ENDIF
  1480. c
  1481. c appel a bjo4 pour le calcul de b
  1482. c
  1483. CcPPj CALL BJO4G(IGAU,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IRRT)
  1484. CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,
  1485. . IRRT)
  1486. c irrt=1 jacobien <= 0
  1487. IF (IRRT.NE.0) THEN
  1488. INTERR(1)=IB
  1489. CALL ERREUR(611)
  1490. GOTO 9972
  1491. ENDIF
  1492. c
  1493. c matrice de hooke
  1494. c
  1495. MPTVAL=IVAMAT
  1496. IF(IMAT.EQ.2) THEN
  1497. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1498. MELVAL=IVAL(1)
  1499. IBMN=MIN(IB ,IELCHE(/2))
  1500. MLREEL=IELCHE(1,IBMN)
  1501. SEGACT MLREEL
  1502. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1503. SEGDES MLREEL
  1504. ENDIF
  1505. ELSE IF (IMAT.EQ.1) THEN
  1506. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1507. DO IM=1,NMATT
  1508. IF (IVAL(IM).NE.0) THEN
  1509. MELVAL=IVAL(IM)
  1510. IBMN=MIN(IB ,VELCHE(/2))
  1511. VALMAT(IM)=VELCHE(1,IBMN)
  1512. ELSE
  1513. VALMAT(IM)=0.D0
  1514. ENDIF
  1515. ENDDO
  1516. CALL DOGO88(VALMAT,CMATE,EPAIST,IFOUR,LHOOK,DDHOOK,IRTD)
  1517. ENDIF
  1518. ENDIF
  1519. c
  1520. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1521. c
  1522. c remplissage du segment contenant les contraintes
  1523. c
  1524. MPTVAL=IVASTR
  1525. DO ICOMP=1,NSTRS
  1526. MELVAL=IVAL(ICOMP)
  1527. IGMN=MIN(IGAU,VELCHE(/1))
  1528. IBMN=MIN(IB ,VELCHE(/2))
  1529. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1530. ENDDO
  1531. ENDDO
  1532. ENDDO
  1533. c
  1534. IF(IRTD.EQ.0) THEN
  1535. MOTERR(1:8)=CMATE
  1536. MOTERR(9:12)=NOMFR(MFR/2+1)
  1537. INTERR(1)=IFOUR
  1538. CALL ERREUR(81)
  1539. ENDIF
  1540. 9972 CONTINUE
  1541. SEGSUP,WRK2,WRK4
  1542. GOTO 510
  1543. c____________________________________________________________________
  1544. c
  1545. c element joint joi3 implementation sans test de planeite
  1546. c et sans repere local
  1547. c____________________________________________________________________
  1548. c
  1549. 86 CONTINUE
  1550. NBNO=NBNN
  1551. SEGINI WRK2,WRK4
  1552. c
  1553. DO 3086 IB=1,NBELEM
  1554. c
  1555. c on cherche les deplacements
  1556. c
  1557. MPTVAL=IVADEP
  1558. IE=1
  1559. DO 5086 IGAU=1,NBNN
  1560. DO 5086 ICOMP=1,NDEP
  1561. MELVAL=IVAL(ICOMP)
  1562. IGMN=MIN(IGAU,VELCHE(/1))
  1563. IBMN=MIN(IB ,VELCHE(/2))
  1564. XDDL(IE)=VELCHE(IGMN,IBMN)
  1565. IE=IE+1
  1566. 5086 CONTINUE
  1567. c
  1568. c on cherche les coordonnees des noeuds de l'element ib
  1569. c
  1570. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1571. c
  1572. c boucle sur les points de gauss
  1573. c
  1574. DO 4086 IGAU=1,NBPGAU
  1575. c
  1576. CALL JO3LOC(XE,SHPTOT,IGAU,NBNN,BPSS)
  1577. c
  1578. c appel a bjo3 pour le calcul de b
  1579. c
  1580. CALL BJO3(IGAU,MFR,IFOUR,NIFOUR,XE,BPSS,SHPTOT,SHPWRK,
  1581. . BGENE,DJAC,IRRT)
  1582. c irrt=1 jacobien <= 0
  1583. IF (IRRT.NE.0) THEN
  1584. INTERR(1)=IB
  1585. CALL ERREUR(612)
  1586. GOTO 9986
  1587. ENDIF
  1588. c
  1589. c matrice de hooke
  1590. c
  1591. MPTVAL=IVAMAT
  1592. IF(IMAT.EQ.2) THEN
  1593. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1594. MELVAL=IVAL(1)
  1595. IBMN=MIN(IB ,IELCHE(/2))
  1596. MLREEL=IELCHE(1,IBMN)
  1597. SEGACT MLREEL
  1598. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1599. SEGDES MLREEL
  1600. ENDIF
  1601. ELSE IF (IMAT.EQ.1) THEN
  1602. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1603. DO 1086 IM=1,NMATT
  1604. IF (IVAL(IM).NE.0) THEN
  1605. MELVAL=IVAL(IM)
  1606. IBMN=MIN(IB ,VELCHE(/2))
  1607. VALMAT(IM)=VELCHE(1,IBMN)
  1608. ELSE
  1609. VALMAT(IM)=0.D0
  1610. ENDIF
  1611. 1086 CONTINUE
  1612. CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1613. ENDIF
  1614. ENDIF
  1615. c
  1616. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1617. c
  1618. c remplissage du segment contenant les contraintes
  1619. c
  1620. MPTVAL=IVASTR
  1621. DO 9086 ICOMP=1,NSTRS
  1622. MELVAL=IVAL(ICOMP)
  1623. IGMN=MIN(IGAU,VELCHE(/1))
  1624. IBMN=MIN(IB ,VELCHE(/2))
  1625. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1626. 9086 CONTINUE
  1627. 4086 CONTINUE
  1628. 3086 CONTINUE
  1629. c
  1630. c impression d'un eventuel message d'erreur
  1631. c
  1632. IF(IRTD.EQ.0) THEN
  1633. MOTERR(1:8)=CMATE
  1634. MOTERR(9:12)=NOMFR(MFR/2+1)
  1635. INTERR(1)=IFOUR
  1636. CALL ERREUR(81)
  1637. ENDIF
  1638. 9986 CONTINUE
  1639. SEGSUP,WRK2,WRK4
  1640. GOTO 510
  1641. c____________________________________________________________________
  1642. c
  1643. c element joint jot3
  1644. c____________________________________________________________________
  1645. c
  1646. 87 CONTINUE
  1647. NBNO=NBNN
  1648. SEGINI WRK2,WRK4
  1649. IF(CMATE.NE.'ISOTROPE')THEN
  1650. MPTVAL=IVAMAT
  1651. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1652. MELVAL=IVAL(4)
  1653. ELSE
  1654. MELVAL=IVAL(2)
  1655. ENDIF
  1656. NBGCOS=VELCHE(/1)
  1657. ENDIF
  1658. c
  1659. DO 3087 IB=1,NBELEM
  1660. c
  1661. c on cherche les deplacements
  1662. c
  1663. MPTVAL=IVADEP
  1664. IE=1
  1665. DO 5087 IGAU=1,NBNN
  1666. DO 5087 ICOMP=1,NDEP
  1667. MELVAL=IVAL(ICOMP)
  1668. IGMN=MIN(IGAU,VELCHE(/1))
  1669. IBMN=MIN(IB ,VELCHE(/2))
  1670. XDDL(IE)=VELCHE(IGMN,IBMN)
  1671. IE=IE+1
  1672. 5087 CONTINUE
  1673. c
  1674. c on cherche les coordonnees des noeuds de l'element ib
  1675. c
  1676. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1677. c
  1678. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1679. c
  1680. c-----------------------------------------------------------------
  1681. c je ne pense pas avoir besoin de transformer les deplacements
  1682. c dans le repere local car la matrice b est un operateur qui
  1683. c s'applique sur une quantite globale, u, pour donner une
  1684. c quantite locale, epsilon ; ceci, du fait de la presence
  1685. c de la matrice teta dans l'expression de b. si cela est vrai,
  1686. c alors il n'est pas necessaire d'appeler matvec.
  1687. c il faudra simplement appeler dbst avec xddl et non pas avec
  1688. c xddloc.
  1689. c-----------------------------------------------------------------
  1690. ccccccccc call matvec(xddl,xddloc,bpss,8)
  1691. c
  1692. c boucle sur les points de gauss
  1693. c
  1694. DO 4087 IGAU=1,NBPGAU
  1695. c
  1696. c appel a bjt3 pour le calcul de b
  1697. c
  1698. CALL BJT3(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1699. . BGENE,DJAC,IRRT)
  1700. c irrt=1 jacobien <= 0
  1701. IF (IRRT.NE.0) THEN
  1702. INTERR(1)=IB
  1703. CALL ERREUR(611)
  1704. GOTO 9987
  1705. ENDIF
  1706. c
  1707. c matrice de hooke
  1708. c
  1709. MPTVAL=IVAMAT
  1710. IF(IMAT.EQ.2) THEN
  1711. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1712. MELVAL=IVAL(1)
  1713. IBMN=MIN(IB ,IELCHE(/2))
  1714. MLREEL=IELCHE(1,IBMN)
  1715. SEGACT MLREEL
  1716. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1717. SEGDES MLREEL
  1718. ENDIF
  1719. ELSE IF (IMAT.EQ.1) THEN
  1720. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1721. DO 1087 IM=1,NMATT
  1722. IF (IVAL(IM).NE.0) THEN
  1723. MELVAL=IVAL(IM)
  1724. IBMN=MIN(IB ,VELCHE(/2))
  1725. VALMAT(IM)=VELCHE(1,IBMN)
  1726. ELSE
  1727. VALMAT(IM)=0.D0
  1728. ENDIF
  1729. 1087 CONTINUE
  1730. CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1731. ENDIF
  1732. ENDIF
  1733. c
  1734. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1735. c
  1736. c remplissage du segment contenant les contraintes
  1737. c
  1738. MPTVAL=IVASTR
  1739. DO 9087 ICOMP=1,NSTRS
  1740. MELVAL=IVAL(ICOMP)
  1741. IGMN=MIN(IGAU,VELCHE(/1))
  1742. IBMN=MIN(IB ,VELCHE(/2))
  1743. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1744. 9087 CONTINUE
  1745. 4087 CONTINUE
  1746. 3087 CONTINUE
  1747. c
  1748. IF(IRTD.EQ.0) THEN
  1749. MOTERR(1:8)=CMATE
  1750. MOTERR(9:12)=NOMFR(MFR/2+1)
  1751. INTERR(1)=IFOUR
  1752. CALL ERREUR(81)
  1753. ENDIF
  1754. 9987 CONTINUE
  1755. SEGSUP,WRK2,WRK4
  1756. GOTO 510
  1757. c____________________________________________________________________
  1758. c
  1759. c element joint joi4
  1760. c____________________________________________________________________
  1761. c
  1762. 88 CONTINUE
  1763. NBNO=NBNN
  1764. SEGINI WRK2,WRK4
  1765. IF(CMATE.NE.'ISOTROPE')THEN
  1766. MPTVAL=IVAMAT
  1767. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1768. MELVAL=IVAL(4)
  1769. ELSE
  1770. MELVAL=IVAL(2)
  1771. ENDIF
  1772. NBGCOS=VELCHE(/1)
  1773. ENDIF
  1774. DO 3088 IB=1,NBELEM
  1775. c
  1776. c on cherche les deplacements
  1777. c
  1778. MPTVAL=IVADEP
  1779. IE=1
  1780. DO 5088 IGAU=1,NBNN
  1781. DO 5088 ICOMP=1,NDEP
  1782. MELVAL=IVAL(ICOMP)
  1783. IGMN=MIN(IGAU,VELCHE(/1))
  1784. IBMN=MIN(IB ,VELCHE(/2))
  1785. XDDL(IE)=VELCHE(IGMN,IBMN)
  1786. IE=IE+1
  1787. 5088 CONTINUE
  1788. c
  1789. c on cherche les coordonnees des noeuds de l'element ib
  1790. c
  1791. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1792. c
  1793. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1794. c
  1795. c-----------------------------------------------------------------
  1796. c je ne pense pas avoir besoin de transformer les deplacements
  1797. c dans le repere local car la matrice b est un operateur qui
  1798. c s'applique sur une quantite globale, u, pour donner une
  1799. c quantite locale, epsilon ; ceci, du fait de la presence
  1800. c de la matrice teta dans l'expression de b. si cela est vrai,
  1801. c alors il n'est pas necessaire d'appeler matvec.
  1802. c il faudra simplement appeler dbst avec xddl et non pas avec
  1803. c xddloc.
  1804. c-----------------------------------------------------------------
  1805. ccccccccc call matvec(xddl,xddloc,bpss,8)
  1806. c
  1807. c boucle sur les points de gauss
  1808. c
  1809. DO 4088 IGAU=1,NBPGAU
  1810. c
  1811. c appel a bjo4 pour le calcul de b
  1812. c
  1813. CALL BJO4(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1814. c irrt=1 jacobien <= 0
  1815. IF (IRRT.NE.0) THEN
  1816. INTERR(1)=IB
  1817. CALL ERREUR(611)
  1818. GOTO 9988
  1819. ENDIF
  1820. c
  1821. c matrice de hooke
  1822. c
  1823. MPTVAL=IVAMAT
  1824. IF(IMAT.EQ.2) THEN
  1825. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1826. MELVAL=IVAL(1)
  1827. IBMN=MIN(IB ,IELCHE(/2))
  1828. MLREEL=IELCHE(1,IBMN)
  1829. SEGACT MLREEL
  1830. CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1831. SEGDES MLREEL
  1832. ENDIF
  1833. ELSE IF (IMAT.EQ.1) THEN
  1834. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1835. DO 1088 IM=1,NMATT
  1836. IF (IVAL(IM).NE.0) THEN
  1837. MELVAL=IVAL(IM)
  1838. IBMN=MIN(IB ,VELCHE(/2))
  1839. VALMAT(IM)=VELCHE(1,IBMN)
  1840. ELSE
  1841. VALMAT(IM)=0.D0
  1842. ENDIF
  1843. 1088 CONTINUE
  1844. CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1845. ENDIF
  1846. ENDIF
  1847. c
  1848. CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1849. c
  1850. c remplissage du segment contenant les contraintes
  1851. c
  1852. MPTVAL=IVASTR
  1853. DO 9088 ICOMP=1,NSTRS
  1854. MELVAL=IVAL(ICOMP)
  1855. IGMN=MIN(IGAU,VELCHE(/1))
  1856. IBMN=MIN(IB ,VELCHE(/2))
  1857. VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1858. 9088 CONTINUE
  1859. 4088 CONTINUE
  1860. 3088 CONTINUE
  1861. c
  1862. c impression d'un eventuel message d'erreur
  1863. IF(IRTD.EQ.0) THEN
  1864. MOTERR(1:8)=CMATE
  1865. MOTERR(9:12)=NOMFR(MFR/2+1)
  1866. INTERR(1)=IFOUR
  1867. CALL ERREUR(81)
  1868. ENDIF
  1869. 9988 CONTINUE
  1870. SEGSUP,WRK2,WRK4
  1871. GOTO 510
  1872. c____________________________________________________________________
  1873. c
  1874. c element dst
  1875. c____________________________________________________________________
  1876. c
  1877. 93 CONTINUE
  1878. NBNO=NBNN
  1879. SEGINI WRK2,WRK3,WRK4
  1880. IF(CMATE.NE.'ISOTROPE')THEN
  1881. MPTVAL=IVAMAT
  1882. IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1883. MELVAL=IVAL(7)
  1884. ELSE
  1885. MELVAL=IVAL(2)
  1886. ENDIF
  1887. NBGCOS=VELCHE(/1)
  1888. ENDIF
  1889. c
  1890. DO 3093 IB=1,NBELEM
  1891. c
  1892. c on cherche les deplacements
  1893. c
  1894. MPTVAL=IVADEP
  1895. IE=1
  1896. DO 4093 IGAU=1,NBNN
  1897. DO 4093 ICOMP=1,NDEP
  1898. MELVAL=IVAL(ICOMP)
  1899. IGMN=MIN(IGAU,VELCHE(/1))
  1900. IBMN=MIN(IB ,VELCHE(/2))
  1901. XDDL(IE)=VELCHE(IGMN,IBMN)
  1902. IE=IE+1
  1903. 4093 CONTINUE
  1904. c
  1905. c on cherche les coordonnees des noeuds de l'element ib
  1906. c
  1907. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1908. CALL VPAST(XE,BPSS)
  1909. c bpss stocke la matrice de passage
  1910. CALL VCORLC (XE,XEL,BPSS)
  1911. CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  1912. c
  1913. c on cherche les epaiseurs et on les moyenne,
  1914. c les excentrements et on les moyenne.
  1915. c
  1916. EPAIST=0.D0
  1917. MPTVAL=IVACAR
  1918. MELVAL=IVAL(1)
  1919. IF (MELVAL.NE.0) THEN
  1920. DO IGAU=1,NBPGAU
  1921. IGMN=MIN(IGAU,VELCHE(/1))
  1922. IBMN=MIN(IB,VELCHE(/2))
  1923. EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  1924. ENDDO
  1925. EPAIST=EPAIST/NBPGAU
  1926. ENDIF
  1927. *
  1928. EXCEN=0.D0
  1929. MELVAL=IVAL(2)
  1930. IF (MELVAL.NE.0) THEN
  1931. DO IGAU=1,NBPGAU
  1932. IGMN=MIN(IGAU,VELCHE(/1))
  1933. IBMN=MIN(IB,VELCHE(/2))
  1934. EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  1935. ENDDO
  1936. EXCEN=EXCEN/NBPGAU
  1937. ENDIF
  1938. c
  1939. c boucle sur les points de gauss
  1940. c
  1941. DO 5093 IGAU=1,NBPTEL
  1942. *
  1943. * dans le cas des matériaux orthotropes, les déformations sont d'abord
  1944. * calculées dans le repère d'orthotropie (les formules utilisées par les
  1945. * routines rcdst et bmfdst ne sont valables que dans ce repère); elles
  1946. * sont ensuite exprimées dans le repère local de l'élément.
  1947. *
  1948. IF(IMAT.EQ.2)THEN
  1949. IF(CMATE.NE.'ISOTROPE')THEN
  1950. IF(IGAU.LE.NBGCOS)THEN
  1951. MPTVAL=IVAMAT
  1952. MELVAL=IVAL(2)
  1953. IBMN=MIN(IB ,VELCHE(/2))
  1954. IGMN=MIN(IGAU,VELCHE(/1))
  1955. COSA=VELCHE(IGMN,IBMN)
  1956. MELVAL=IVAL(3)
  1957. IBMN=MIN(IB ,VELCHE(/2))
  1958. IGMN=MIN(IGAU,VELCHE(/1))
  1959. SINA=VELCHE(IGMN,IBMN)
  1960. ENDIF
  1961. ENDIF
  1962. ENDIF
  1963. c
  1964. c on cherche la matrice de hooke
  1965. c
  1966. MPTVAL=IVAMAT
  1967. IF(IMAT.EQ.2) THEN
  1968. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1969. MELVAL=IVAL(1)
  1970. IBMN=MIN(IB ,IELCHE(/2))
  1971. IGMN=MIN(IGAU,IELCHE(/1))
  1972. MLREEL=IELCHE(IGMN,IBMN)
  1973. SEGACT MLREEL
  1974. CALL DOHOOO(PROG,LHOOK,DDHOMU)
  1975. SEGDES MLREEL
  1976. IF(CMATE.EQ.'ORTHOTRO')
  1977. + CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  1978. ENDIF
  1979. ELSE IF (IMAT.EQ.1) THEN
  1980. IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1981. DO 9193 IM=1,NMATT
  1982. IF (IVAL(IM).NE.0) THEN
  1983. MELVAL=IVAL(IM)
  1984. IBMN=MIN(IB ,VELCHE(/2))
  1985. IGMN=MIN(IGAU,VELCHE(/1))
  1986. VALMAT(IM)=VELCHE(IGMN,IBMN)
  1987. ELSE
  1988. VALMAT(IM)=0.D0
  1989. ENDIF
  1990. 9193 CONTINUE
  1991. CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  1992. ENDIF
  1993. CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  1994. ENDIF
  1995. call zero(bgene,nstrs,lre)
  1996. IF(CMATE.NE.'ISOTROPE')THEN
  1997. IF(IGAU.LE.NBGCOS)THEN
  1998. IF(IMAT.EQ.1) THEN
  1999. COSA=VALMAT(7)
  2000. SINA=VALMAT(8)
  2001. ENDIF
  2002. DO 1393 INO=1,NBNN
  2003. XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  2004. YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  2005. XE(1,INO)=XX
  2006. XE(2,INO)=YY
  2007. 1393 CONTINUE
  2008. ENDIF
  2009. c
  2010. c termes de la matrice de rigidite relatifs
  2011. c aux cisaillements transverses
  2012. c
  2013. CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  2014. 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  2015. c
  2016. c termes de la matrice b relatifs aux effets
  2017. c de membrane et de flexion
  2018. c
  2019. CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  2020. 1 WORK(1),WORK(10),WORK(19),BGENE,DUM)
  2021. *
  2022. CALL ROTB(BGENE,NSTRS,COSA,SINA)
  2023. ELSE
  2024. c
  2025. c termes de la matrice b relatifs aux cisaillements transverses
  2026. c
  2027. CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  2028. 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  2029. c
  2030. c termes de la matrice b relatifs aux effets
  2031. c de membrane et de flexion
  2032. c
  2033. CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  2034. 1 WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  2035. ENDIF
  2036. *
  2037. * on modifie la matrice b en cas d'excentrement
  2038. *
  2039. IF (EXCEN.NE.0.D0) THEN
  2040. DO 1593 IJL=1,3
  2041. DO 1593 IJC=1,LRE
  2042. BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  2043. 1593 CONTINUE
  2044. ENDIF
  2045. *
  2046. CALL DBST(BGENE,DDHOMU,XDDLOC,LRE,NSTRS,XSTRS)
  2047. c
  2048. c calcul des eps 2
  2049. c
  2050. IF(IREPS2.EQ.1)THEN
  2051. IF(CMATE.EQ.'ORTHOTRO')THEN
  2052. CALL DBDST2(XE,DDHOMU,XDDLOC,IGAU,BGENE,CMATE,
  2053. 1 COSA,SINA,XSTRS)
  2054. ELSE
  2055. CALL DBDST2(XEL,DDHOMU,XDDLOC,IGAU,BGENE,CMATE,
  2056. 1 COSA,SINA,XSTRS)
  2057. ENDIF
  2058. ENDIF
  2059. *
  2060. * changement de repere: ortho -> local
  2061. *
  2062. IF(CMATE.EQ.'ORTHOTRO')
  2063. 1 CALL CHGREP2(COSA,SINA,XSTRS,0,1)
  2064. c
  2065. c remplissage du segment contenant les contraintes
  2066. c
  2067. MPTVAL=IVASTR
  2068. DO 9093 ICOMP=1,NSTRS
  2069. MELVAL=IVAL(ICOMP)
  2070. IBMN=MIN(IB ,VELCHE(/2))
  2071. VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  2072. 9093 CONTINUE
  2073. 5093 CONTINUE
  2074. 3093 CONTINUE
  2075. c
  2076. IF (IRTD.EQ.0) THEN
  2077. MOTERR(1:8)=CMATE
  2078. MOTERR(9:12)=NOMFR(MFR/2+1)
  2079. INTERR(1)=IFOUR
  2080. CALL ERREUR(81)
  2081. ENDIF
  2082. 9993 CONTINUE
  2083. SEGSUP,WRK2,WRK3,WRK4
  2084. GOTO 510
  2085. c____________________________________________________________________
  2086. c____________________________________________________________________
  2087. 99 CONTINUE
  2088. MOTERR(1:4)=NOMTP(MELE)
  2089. MOTERR(9:12)='SIGM'
  2090. CALL ERREUR(86)
  2091. *
  2092. c- Fin du sous-programme
  2093. 510 CONTINUE
  2094. SEGSUP MVELCH,WRK1
  2095.  
  2096. RETURN
  2097. END
  2098.  
  2099.  
  2100.  
  2101.  
  2102.  
  2103.  

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