Télécharger bone.eso

Retour à la liste

Numérotation des lignes :

  1. C BONE SOURCE CB215821 16/04/21 21:15:22 8920
  2. SUBROUTINE BONE(SIGR,SIGF,DSTRN,IPLA,IFISU,SIG1,SIG2
  3. A ,NSTRS,D,D1,IFOUB,SIGP,EPST,SIR,SIRL,ENDO
  4. B ,ITHHER,T0,TF,BETJEF,VISCO,BETFLU
  5. B ,NECH0,NECH1,NECH2,NECH3)
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. DIMENSION SIGR(4),DSIGT(4),SIGF(4),S1(4),DSTRN(4),SIGT(4)
  10. DIMENSION EPSR(9),S2(4),V2(4),V1(4)
  11. DIMENSION S(6),SI1(6),EPST(4),SIGRV(4)
  12. DIMENSION ST0(6),V02(4),SI0(6),V01(4),SIGP(4)
  13. DIMENSION SIGIST(4),EXU(9),CODU(9,9),COD(8),TZU(19)
  14. DIMENSION STRNI(9),SOM(9),DEFMAX(9),DDSTRN(9)
  15. DIMENSION H(4,4),DSTFL(4),S3(4)
  16. DIMENSION DEP(4,4),D1(4,4),D(4,4),SIRL(8,4),SIR(9,4)
  17. DIMENSION DEPE(4,4),DH(4,4),HI(4,4),CODL(8,8)
  18. *
  19. SEGMENT BETJEF
  20. REAL*8 AA,BETA,RB,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
  21. & TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  22. INTEGER ICT,ICC,IMOD,IVIS,ITER,
  23. & ISIM,IBB,IGAU,IZON
  24. ENDSEGMENT
  25. REAL*8 DPSTV1,DPSTV2,SIGV1,SIGV2,ENDV
  26. ENDSEGMENT
  27. SEGMENT BETFLU
  28. REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  29. & TP0,TZER
  30. INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
  31. ENDSEGMENT
  32. SEGMENT NECH0
  33. REAL*8 DT,DC,ALFG,S0,ENDO
  34. ENDSEGMENT
  35. SEGMENT NECH1
  36. REAL*8 DLMT
  37. ENDSEGMENT
  38. SEGMENT NECH2
  39. REAL*8 ATR,GTR,ALPH0
  40. ENDSEGMENT
  41. SEGMENT NECH3
  42. REAL*8 RBT,ALFAT,YOUNT,GFCT,GFTT,ALPH
  43. ENDSEGMENT
  44. C
  45. TAU1=0.05
  46. NTPS=18
  47. NTZERO=18
  48. NCOE=8
  49. MC=NBRC+1
  50. NC=NCOE+1
  51. C
  52. C--------------------------------------------------------------------------
  53. C ************************************************************
  54. C * APPLICATION DES CRITERES DE PLASTICITE ET FISSURATION *
  55. C * CRITERE BETON *
  56. C * *
  57. C * IFISU=INDICE DE FISSURATION *
  58. C * =0 PAS DE FISSURE *
  59. C * =1 UNE FISSURE *
  60. C * =2 RUINE DANS DIRECTION DE TRACTION *
  61. C * *
  62. C * IPLA =INDICE DE PLASTICITE *
  63. C * =0 ELASTIQUE *
  64. C * =1 ECROUISSAGE POSITIF *
  65. C * =2 RUPTURE PAR COMPRESSION DANS 1 DIRECTION *
  66. C * *
  67. C * *
  68. C * *
  69. C ************************************************************
  70. C---------------------------------------------------------------------
  71.  
  72. AA = 1.D0/3.D0
  73. CALL ZERO(DSIGT,4,1)
  74. CALL ZERO(SIGT,4,1)
  75. CALL ZERO(SIGIST,4,1)
  76. CALL ZERO(SIGRV,4,1)
  77. CALL ZERO(CODU,9,9)
  78. CALL ZERO(CODL,8,8)
  79. CALL ZERO(COD,8,1)
  80. CALL ZERO(S1,4,1)
  81. CALL ZERO(S2,4,1)
  82. CALL ZERO(V1,4,1)
  83. CALL ZERO(V2,4,1)
  84. CALL ZERO(D,4,4)
  85. CALL ZERO(DEP,4,4)
  86. CALL ZERO(H,4,4)
  87. CALL ZERO(HI,4,4)
  88. DAM = 0.D0
  89. C
  90. C ****************** INITIALISATION POUR VISCOPLASTIQUE ***************
  91. C
  92. IF (IVIS.EQ.1.OR.IVIS.EQ.4) THEN
  93. DO 5 I=1,NSTRS
  94. SIGRV(I)= SIGR(I)
  95. 5 CONTINUE
  96. ENDIF
  97. IF ((IVIS.EQ.1.AND.(IPLA.GT.0.OR.IFISU.GT.0)).OR.
  98. & (IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0))) THEN
  99. C
  100. DO 6 I=1,NSTRS
  101. SIGR(I)= SIGP(I)
  102. 6 CONTINUE
  103. ENDIF
  104. DO 7 I=1,NSTRS
  105. SIGR(I)= SIGR(I)/(1.D0-ENDO)
  106. 7 CONTINUE
  107. C
  108. C ****************** INITIALISATION POUR VISCOELASTIQUE ***************
  109. C
  110. IF (IVIS.EQ.2) THEN
  111. SEL1=0.D0
  112. SEL2=0.D0
  113. EX=0.D0
  114. TPS1 = TP0
  115. TPS2 = TP0+PDT
  116. ENDIF
  117. C
  118. CALL INFICH(CODU,CODL,COD,BETJEF,BETFLU)
  119. CALL MODBET(TPS1,TPS2,SEL1,SEL2,EXU,EXUL,EX,CODU,CODL
  120. & ,COD,BETJEF,BETFLU)
  121. C WRITE(*,*)'EX=',EX,'a T=',TPS2
  122. IF (IFOR.EQ.1) THEN
  123. CALL CALIS1(SIGIST,NSTRS,DSTRN,IFOUB,SIR,CODU,CODL,
  124. & COD,BETJEF,BETFLU)
  125. ENDIF
  126. IF (IFOR.EQ.2) THEN
  127. CALL CALIS2(SIGIST,NSTRS,DSTRN,IFOUB,SIRL,CODU,CODL,
  128. & COD,BETJEF,BETFLU)
  129. ENDIF
  130. C
  131. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  132. C INITIALISATION DE L'ENDOMMAGEMENT
  133. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  134. IF(IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  135. IF((IFISU.EQ.0.D0).AND.(IPLA.EQ.0.D0))THEN
  136. ENDO=0.D0
  137. DO 300 I =1, NSTRS
  138. STRNI(I)=0.D0
  139. 300 CONTINUE
  140. ENDIF
  141. C
  142. DO 400 I=1, NSTRS
  143. SOM(I)=SOM(I)+DSTRN(I)
  144. DEFMAX(I)=MAX(ABS(SOM(I)),ABS(STRNI(I)))
  145. DDSTRN(I)=ABS(SOM(I))-ABS(DEFMAX(I))
  146. 400 CONTINUE
  147.  
  148. C
  149. DO 500 I=1, NSTRS
  150. STRNI(I)=DEFMAX(I)
  151. 500 CONTINUE
  152. C
  153. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  154. C TEST SUR LE TYPE DE CHARGEMENT
  155. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  156. C
  157. DO 200 I=1,NSTRS
  158. IF (DDSTRN(I).LT.0.D0) THEN
  159. DSTRN(I)=(1.D0-ENDO)*DSTRN(I)
  160. ENDIF
  161. 200 CONTINUE
  162. C
  163. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  164. C CALCUL DE LA MATRICE D'INTERACTION THERMO-MECA [H]
  165. C ET INVERSE DE [H]
  166. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  167. C
  168. CALL INTERF(ITHHER,T0,TF,NSTRS,H,BETJEF,NECH2)
  169. C
  170. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  171. C CALCUL DE LA DEFORMATION D'INTERACTION
  172. C THERMO-MECA [DSTFL]AU PAS N
  173. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  174. C
  175. CALL TRANSI(ITHHER,T0,TF,NSTRS,HI,BETJEF,NECH2)
  176. C
  177. DO 250 I=1,NSTRS
  178. DSTFL(I)=0.D0
  179. DO 250 J=1,NSTRS
  180. DSTFL(I)=DSTFL(I)+HI(I,J)*SIGF(J)
  181. 250 CONTINUE
  182. C
  183. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  184. C CALCUL DE LA DEFORMATION DU TIRE ELASTIQUE
  185. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  186. C
  187. DO 260 I=1,NSTRS
  188. DSTRN(I)=DSTRN(I)-DSTFL(I)
  189. 260 CONTINUE
  190. C
  191. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  192. C
  193. CALL INVMA2(H,NSTRS,ISING)
  194. ENDIF
  195. C
  196. C ************************** CAS CONTRAINTE PLANE *********************
  197. C
  198. IF (IFOUB.EQ.-2) THEN
  199. IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  200. CALL CREMAT(DH,EX,XNU,3,IFOUB)
  201. CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS)
  202. ELSE
  203. CALL CREMAT(DEP,EX,XNU,3,IFOUB)
  204. ENDIF
  205. IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
  206. CALL PROMA2(DEP,DSTRN,3,DSIGT)
  207. DO 2 I=1,NSTRS
  208. SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I)
  209. 2 CONTINUE
  210. ENDIF
  211. IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN
  212. WRITE(*,*)'ATTENTION IMOD=2 ou 4 -> DEFORMATIONS PLANES'
  213. STOP
  214. ENDIF
  215. ENDIF
  216. C
  217. C ***** CAS DEFORMATION PLANE ou AXISYMETRIQUE ***************
  218. C
  219. IF (IFOUB.EQ.-1.OR.IFOUB.EQ.0) THEN
  220. IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  221. CALL CREMAT(DH,EX,XNU,4,IFOUB)
  222. CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS)
  223. ELSE
  224. CALL CREMAT(DEP,EX,XNU,4,IFOUB)
  225. ENDIF
  226. CALL PROMA2(DEP,DSTRN,4,DSIGT)
  227. DO 3 I=1,NSTRS
  228. SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I)
  229. 3 CONTINUE
  230. IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
  231. WRITE(*,*)'ATTENTION IMOD=1 ou 3 -> CONTRAINTES PLANES'
  232. STOP
  233. ENDIF
  234. ENDIF
  235. C
  236. C ************************ Normalisation *********************
  237. C
  238. DO 1 I=1,NSTRS
  239. IF(ABS(SIGR(I)).LT.1.D-6) SIGR(I)=0.D0
  240. IF(ABS(SIGT(I)).LT.1.D-6) SIGT(I)=0.D0
  241. 1 CONTINUE
  242. C---------------------------------------------------------------------
  243. DO 11 I=1,NSTRS
  244. S1(I)=SIGT(I)
  245. 11 CONTINUE
  246. CALL PRINC(S1,V1,NSTRS)
  247. C
  248. C **************** TEST DU TYPE DE SOLLICITATION *********************
  249. C
  250. IZON=1
  251. IF(V1(1).LT.0.D0.AND.V1(2).LT.0.D0) IZON=0
  252. IF(V1(1).GE.0.D0.AND.V1(2).GE.0.D0) IZON=2
  253. C---------------------------------------------------------------------
  254. C IF (IFISU.NE.0) GOTO 15
  255. IF (IZON.EQ.0) GOTO 30
  256. IF (IZON.EQ.1.OR.IZON.EQ.2) GOTO 15
  257. C
  258. C ******************** COMPORTEMENT DE TRACTION **********************
  259. C
  260. 15 CONTINUE
  261. C #####################################
  262. C * POINT DEJA FISSURE *
  263. C * COMPORTEMENT PLASTIQUE *
  264. C #####################################
  265. C
  266. IF(IFISU.NE.0) THEN
  267. IF(IZON.EQ.2) THEN
  268. CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  269. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  270. A BETJEF,VISCO,NECH0,NECH1)
  271. GOTO 40
  272. ENDIF
  273. IF(IZON.EQ.1) THEN
  274. CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  275. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  276. A BETJEF,VISCO,NECH0,NECH1)
  277. GOTO 40
  278. ENDIF
  279. IF(IZON.EQ.0) THEN
  280. WRITE(*,*)'Dans elasbet un point deja fissure est teste en
  281. *bicompression'
  282. WRITE(*,*)'Element num:',IBB ,'au point de Gauss num:',IGAU
  283. STOP
  284. ENDIF
  285. ENDIF
  286. C---------------------------------------------------------------------
  287. C #####################################
  288. C * POINT FISSURE 1ER FOIS *
  289. C * COMPORTEMENT PLASTIQUE *
  290. C #####################################
  291. C
  292. Ft=ALPHA*RB
  293. IF(V1(1).GT.Ft) THEN
  294. IF(IZON.EQ.2) THEN
  295. CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  296. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  297. A BETJEF,VISCO,NECH0,NECH1)
  298. GOTO 40
  299. ENDIF
  300. IF(IZON.EQ.1) THEN
  301. CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  302. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  303. A BETJEF,VISCO,NECH0,NECH1)
  304. GOTO 40
  305. ENDIF
  306. ENDIF
  307. IF(IZON.EQ.1.AND.IPLA.EQ.0) THEN
  308. IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  309. CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  310. ENDIF
  311. IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  312. CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  313. ENDIF
  314. FCRI=SEQ-RB*AA
  315. IF(FCRI.GT.0.D0) THEN
  316. CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  317. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  318. A BETJEF,VISCO,NECH0,NECH1)
  319. GOTO 40
  320. ENDIF
  321. ENDIF
  322. IF(IZON.EQ.1.AND.IPLA.GE.1) THEN
  323. IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  324. CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  325. ENDIF
  326. IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  327. CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  328. ENDIF
  329. FCRI=SEQ-SIG2
  330. IF(FCRI.GT.0.D0) THEN
  331. CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  332. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  333. A BETJEF,VISCO,NECH0,NECH1)
  334. GOTO 40
  335. ENDIF
  336. ENDIF
  337. GOTO 40
  338. C
  339. C *************** COMPORTEMENT DE BICOMPRESSION **********************
  340. C
  341. 30 CONTINUE
  342. C---------------------------------------------------------------------
  343. IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  344. CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  345. ENDIF
  346. IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  347. CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  348. ENDIF
  349. FCRI=SEQ-RB*AA
  350. IF (FCRI.GT.0.D0.OR.IPLA.NE.0) THEN
  351. CALL BEHAV2(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  352. A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  353. A BETJEF,VISCO,NECH0,NECH1)
  354. GOTO 40
  355. ENDIF
  356. C---------------------------------------------------------------------
  357. 40 CONTINUE
  358. C---------------------------------------------------------------------
  359. C
  360. IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  361. IF(IVIS.EQ.3) THEN
  362. CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,S2,DAM,
  363. & NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1)
  364. ENDO = DAM
  365. DO 98 I=1,NSTRS
  366. S1(I)= S2(I)
  367. 98 CONTINUE
  368. ENDIF
  369. IF(IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0)) THEN
  370. CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,SIGP,DAM,
  371. & NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1)
  372. ENDO = DAM
  373. CALL VISPL1(SIGP,DSIGT,NSTRS,S2,SIGRV,DSTRN,
  374. & DPSTF1,DPSTF2,BETJEF,VISCO,NECH0,NECH1)
  375. DO 99 I=1,NSTRS
  376. S1(I)= S2(I)
  377. 99 CONTINUE
  378. ENDIF
  379. ENDIF
  380. C
  381. C MODIF DEP ET CONTRAINTES
  382. C
  383. DO 121 I=1,NSTRS
  384. DO 121 J=1,NSTRS
  385. D(I,J)=DEP(I,J)
  386. 121 CONTINUE
  387. C---------------------------------------------------------------------
  388. 50 CONTINUE
  389. C---------------------------------------------------------------------
  390. DO 42 I=1,NSTRS
  391. C IF(ABS(S1(I)).LT.1.D-6) S1(I)=0.D0
  392. SIGF(I)= S1(I)
  393. C WRITE(*,*)'SIGF(',I,')=',SIGF(I)
  394. 42 CONTINUE
  395. C
  396. C
  397. 70 FORMAT (4(1X,E12.5))
  398. RETURN
  399. END
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  

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