Télécharger betdje.eso

Retour à la liste

Numérotation des lignes :

  1. C BETDJE SOURCE CB215821 16/04/21 21:15:20 8920
  2. C BETDJE SOURCE INSL 24/10/96
  3. SUBROUTINE BETDJE(EPSR,SIGR,SIGM,NSTRS,D,D1,IFOUB,STRN,EPSPL,
  4. 1 EPFLT,EPFL0,XE,NBNN,MELE,wrk12)
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. CHARACTER*8 NOROU1
  9. DIMENSION SIGR(6),SIGMR(6),S1(6),STRNR(6),SIGM(NSTRS)
  10. DIMENSION EPSR(6),D1(NSTRS,NSTRS),S2(6),D(NSTRS,NSTRS),V1(4)
  11. DIMENSION STRN(NSTRS),S(6),EPFLT(NSTRS),EPFL0(NSTRS),XE(3,NBNN)
  12. segment wrk12
  13. real*8 AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX
  14. real*8 EPUT,FTC,EPO,EPO1,ENGF,RMOY,PHIF,TEMP0
  15. real*8 DTEMP1,TEMP1,POAR,SCT,TETA,DTR1,DTR2,EDC1
  16. real*8 EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1
  17. real*8 TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1
  18. real*8 EQSTR2,EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3
  19. real*8 RTM3,EDC3,ETS3,EDT3,OUV3,TANG3
  20. integer ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2
  21. integer IFISU1,JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1
  22. endsegment
  23. *
  24. * COMMON /CINSA/ AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX,EPUT,FTC,EPO,
  25. * 1 EPO1,ENGF,RMOY,PHIF,TEMP0,DTEMP1,TEMP1,POAR,SCT,TETA,
  26. * 2 DTR1,DTR2,EDC1,EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1,
  27. * 3 TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1,EQSTR2,
  28. * 4 EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3,RTM3,EDC3,
  29. * 5 ETS3,EDT3,OUV3,TANG3,
  30. * 6 ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2,IFISU1,
  31. * 7 JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1
  32. C
  33. C---------------------------------------------------------------------
  34. C ************************************************************
  35. C * APPLICATION DES CRITERES DE PLASTICITE ET FISSURATION *
  36. C * CRITERE BETON D'OTTOSEN *
  37. C * *
  38. C * JFISU=INDICE DE FISSURATION *
  39. C * =0 PAS DE FISSURE *
  40. C * =1 UNE FISSURE *
  41. C * =2 RUPTURE TRACTION (sigma=0, epsilon > epsut)*
  42. C * *
  43. C * IPLA1=INDICE DE PLASTICITE *
  44. C * =0 ECROUISSAGE POSITIF *
  45. C * =2 ECROUISSAGE NEGATIF OU PALIER PLASTIQUE *
  46. C * =3 RUPTURE PAR COMPRESSION DANS 1 DIRECTION *
  47. C * =4 POINT BIAXIALEMENT ROMPU *
  48. C * *
  49. C ************************************************************
  50. C
  51. * IFLU = 0 : PAS DE FLUAGE
  52. * IFLU = 10 : FLUAGE (BPEL91_K(t)=2) + BETON ELASTIQUE
  53. * IFLU = 11 : FLUAGE (BPEL91_K(t)=2) + BETON ELASTOPLASTIQUE
  54. * IFLU = 20 : FLUAGE (BPEL91_K(t)..) + BETON ELASTIQUE
  55. * IFLU = 21 : FLUAGE (BPEL91_K(t)..) + BETON ELASTOPLASTIQUE
  56. C---------------------------------------------------------------------
  57. JFRIS=0
  58. TU=RB
  59. SEQC1=0.D0
  60. EPEQC=0.D0
  61. C----------------------------------------------------------------------
  62. C----------------------------------------------------------------------
  63. IPASN = 0
  64. IELM1 = 0
  65. C----------------------------------------------------------------------
  66. C----------------------------------------------------------------------
  67. CALL ZERO(SIGMR,6,1)
  68. CALL ZERO(STRNR,6,1)
  69. CALL ZERO(SIGM,NSTRS,1)
  70. CALL ZERO(S1,6,1)
  71. CALL ZERO(S2,6,1)
  72. CALL ZERO(V1,4,1)
  73. CALL ZERO(EPFLT,NSTRS,1)
  74. C
  75. CALL MATHOO(D,EX,PXY,NSTRS,IFOUB)
  76. CALL BST(D,STRN,NSTRS,NSTRS,SIGM)
  77. C---------------------------------------------------------------------
  78. DO 1 I=1,NSTRS
  79. S1(I)=SIGR(I)+SIGM(I)
  80. SIGMR(I)=S1(I)
  81. 1 CONTINUE
  82. C-----------------------------------------------------------------
  83. * APPELE EVENTUEL A UN MODELE DE FLUAGE POUR LE BETON
  84. *
  85. IF(IFLU.NE.0) THEN
  86. CALL MATSOU(D1,EX,PXY,NSTRS,IFOUB)
  87. CALL MOBFLU(SIGR,EPFLT,D1,NSTRS,IFLU,RMOY,PHIF,TEMP0,
  88. & DTEMP1,TEMP1,POAR)
  89. ENDIF
  90. C-----------------------------------------------------------------
  91. DO I=1,NSTRS
  92. IF(JFISU.EQ.0) THEN
  93. S2(I)=EPSR(I)+STRN(I)+EPFLT(I)
  94. ELSE
  95. S2(I)=EPSR(I)+STRN(I)+EPFLT(I)-EPFL0(I)
  96. ENDIF
  97. STRNR(I)=S2(I)
  98. END DO
  99. C---------------------------------------------------------------------
  100. CALL CRIOTO(SIGMR,SEQB,FCRIB,NSTRS,TU,AA,BB,DK1,DK2)
  101. C----------------------------------------------------------------------
  102. IF(IBB1.EQ.IELM1) THEN
  103. WRITE(*,*) '=========================================='
  104. & ,'=================================================='
  105. DEPEQ=(SEQB-EQSTR1)*(1.D0-2.D0*PXY)/EX
  106. EPEQC=EPSEQ1+DEPEQ
  107. EPOT=FPT/EX
  108. *
  109. WRITE(*,94) IBB1,IGAU1,ICU,ICAL,ILOI,IOUV
  110. 94 FORMAT('ELEM=',I3,' GAUSS=',I2,' ICU=',I1,' ICAL=',I1,' ILOI=',I1
  111. & ,' IOUV=',I2)
  112. WRITE(*,404) JFISU,IPLA1,IFLU,EQSTR1,EPSEQ1,SEQB,EPEQC,EPOT,EPO
  113. *
  114. WRITE(*,*) ' ** SIGR / EPSR '
  115. WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(EPSR(IC),IC=1,NSTRS)
  116. WRITE(*,*) ' ** SIGM / STRN '
  117. WRITE(*,1991) (SIGM(IC),IC=1,NSTRS),(STRN(IC),IC=1,NSTRS)
  118. WRITE(*,*) ' ** SIGMR / STRNR '
  119. WRITE(*,1991) (SIGMR(IC),IC=1,NSTRS),(STRNR(IC),IC=1,NSTRS)
  120. 404 FORMAT('JFISU=',I2,'IPLA1=',I2,'IFLU=',I2,'SEQ0=',E9.3,' EPEQ0='
  121. * ,E9.3,' SEQB=',E9.3,' EPEQC=',E9.3,' EPOT=',E9.3,' EPOC=',E9.3)
  122. ENDIF
  123. C---------------------------------------------------------------------
  124. C---------------------------------------------------------------------
  125. IF(IFLU.EQ.10.OR.IFLU.EQ.20.OR.IFLU.EQ.30) GOTO 40
  126. IF(JFISU.NE.0) GOTO 200
  127. IF(IPLA1.EQ.4) GOTO 100
  128. C--------------------------------------------------------------------
  129. IF(SEQB .LE. EQSTR1) THEN
  130. C ##############################
  131. C * DECHARGE ELASTIQUE *
  132. C ##############################
  133. IPLA2=1
  134. GOTO 40
  135. ENDIF
  136. C--------------------------------------------------------------------
  137. C -------------------------------------------------
  138. C * ON CALCUL LA DEFORMATION EQUIVALENTE ACTUELLE *
  139. C -------------------------------------------------
  140. DEPEQ=(SEQB-EQSTR1)*(1.D0-2.D0*PXY)/EX
  141. EPEQC=EPSEQ1+DEPEQ
  142. C---------------------------------------------------------------------
  143. C -------------------------------------------------
  144. C * ON CALCUL LA CONTRAINTE EQUIVALENTE ACTUELLE *
  145. C -------------------------------------------------
  146. IPLC=0
  147. IF(IPLA1.GE.2.OR.EPEQC.GE.EPO) IPLC=1
  148. IF(ICAL.EQ.0) THEN
  149. CALL CDCY(EPEQC,SEQC,IPLC,EBC11,EX,TU,EMAX,EPO,ICAL)
  150. ELSE
  151. IF(IPLC.NE.0) THEN
  152. EBC11=-TU/(EMAX-EPO)
  153. SEQC=TU*(EMAX-EPEQC)/(EMAX-EPO)
  154. ELSE
  155. EBC11=EX
  156. SEQC=EPEQC*EX
  157. ENDIF
  158. ENDIF
  159. C---------------------------------------------------------------------
  160. IF(IPLA2.EQ.1) THEN
  161. C #########################################
  162. C * POINT INITIALEMENT EN DECHARGE *
  163. C #########################################
  164. C
  165. CALL CRIOTO(SIGR,SEQ01,FCRIB,NSTRS,TU,AA,BB,DK1,DK2)
  166. IF(SEQ01.GT.TU) SEQ01=TU
  167. SEQ0 =SEQ01
  168. EET1 =EPSEQ1-EQSTR1/EX
  169. EPEQ0=SEQ0/EX+EET1
  170. ELSE
  171. EPEQ0=EPSEQ1
  172. SEQ0 =EQSTR1
  173. ENDIF
  174. IPLA2=0
  175. C---------------------------------------------------------------------
  176. C -------------------------------
  177. C * ON CALCUL LE MODULE SECANT *
  178. C -------------------------------
  179. DEPEQ=EPEQC-EPEQ0
  180. IF(ABS(DEPEQ).LE.1.D-15) THEN
  181. EBC1=0.D0
  182. ELSE
  183. EBC1=(SEQC-SEQ0)/DEPEQ
  184. ENDIF
  185. C---------------------------------------------------------------------
  186. EPEQC1=EPEQC
  187. SEQC1=SEQC
  188. C---------------------------------------------------------------------
  189. 100 CONTINUE
  190. C---------------------------------------------------------------------
  191. IF(IPLA1.EQ.4) THEN
  192. C #########################
  193. C * POINT DEJA ROMPU *
  194. C #########################
  195. CALL ZERO(D,NSTRS,NSTRS)
  196. CALL ZERO(S1,NSTRS,1)
  197. EQSTR1=0.D0
  198. EPSEQ1=EPEQC
  199. GOTO 40
  200. ENDIF
  201. C---------------------------------------------------------------------
  202. IF(EPEQC1.GE.EMAX) THEN
  203. C ################################
  204. C * CE POINT VIENT DE ROMPRE *
  205. C ################################
  206. IPLA1=4
  207. GOTO 100
  208. ENDIF
  209. C---------------------------------------------------------------------
  210. 200 CONTINUE
  211. C---------------------------------------------------------------------
  212. IF(JFISU.NE.0) THEN
  213. C #####################################
  214. C * POINT DEJA FISSURE *
  215. C * COMPORTEMENT ORTHOTROPE *
  216. C #####################################
  217. C
  218. CALL FISPLA(EPSR,STRN,STRNR,SIGR,SIGM,S1,NSTRS,IFOUB,1,
  219. A XE,NBNN,MELE,wrk12)
  220. GOTO 40
  221. ENDIF
  222. C--------------------------------------------------------------------
  223. IF(IPLA1.GE.2) THEN
  224. C ###################################################
  225. C * ECROUISSAGE NEGATIF (SOFTENING EN COMPRESSION) *
  226. C ###################################################
  227. C
  228. CALL CALPEC(IFOUB,STRN,SIGR,SIGM,S1,D,NSTRS,SEQC1,EBC1,EPEQC1
  229. 1 ,EPSR,STRNR,JFRIS,IPLA1,EPEQ0,SEQ0,XE,NBNN,MELE,EQSTR1,EPSEQ1,
  230. 2 AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12)
  231. IF(JFRIS.NE.0) GOTO 40
  232. GOTO 30
  233. ENDIF
  234. C---------------------------------------------------------------------
  235. IF(IPLA1.EQ.0.AND.JFISU.EQ.0) THEN
  236. C #####################################
  237. C * POINT INTEGRE *
  238. C #####################################
  239. C
  240. CALL PINOTO(EPSR,STRN,STRNR,SIGR,SIGMR,SIGM,S1,V1,D,IPLA1,
  241. 1 JFRIS,NSTRS,IFOUB,EPEQC1,SEQC1,EBC1,EPEQ0,SEQ0,SEQB,XE,NBNN,
  242. 2 MELE,EQSTR1,EPSEQ1,AA,BB,DK1,DK2,ILOI,ALPHA,RB,EX,PXY,EPO,ICAL
  243. 3 , wrk12)
  244. C
  245. IF(JFRIS.NE.0) GOTO 40
  246. ENDIF
  247. C---------------------------------------------------------------------
  248. 30 CONTINUE
  249. C==================================================================
  250. CALL CRIOTO(S1,SEQC,FCRIC,NSTRS,TU,AA,BB,DK1,DK2)
  251. IF(SEQC.GT.(1.0005D0*TU)) THEN
  252. C---------------------------------------------------------------------
  253. DO 18 I=1,NSTRS
  254. S(I)=S1(I)-SIGR(I)
  255. 18 CONTINUE
  256. TETA0=TETA
  257. DTR10=DTR1
  258. DTR20=DTR2
  259. NOROU1=' BETDJE '
  260. CALL SCALT(S,SIGR,S1,V1,SCT,NSTRS,DTAU,TU,AA,BB,DK1,DK2,
  261. & ALPHA,RB,DTR1,DTR2,TETA)
  262. CALL CRIOTO(S1,SEQC2,FCRIC,NSTRS,TU,AA,BB,DK1,DK2)
  263. TETA=TETA0
  264. DTR1=DTR10
  265. DTR2=DTR20
  266. SEQC=SEQC2
  267. IF(SEQC.GT.TU) SEQC=TU
  268. EPEQC=EPO
  269. C---------------------------------------------------------------------
  270. ENDIF
  271. C==================================================================
  272. 71 CONTINUE
  273. C==================================================================
  274. IF(SEQC.GT.TU) SEQC=TU
  275. IPL0 = 0
  276. IF(IPLA1.NE.0.OR.JFISU.NE.0) IPL0 = 1
  277. C---------------------------------------------------------------------
  278. IF(ICAL.EQ.1) THEN
  279. IF(IPL0.EQ.0) EPEQC=SEQC/EX
  280. IF(IPL0.NE.0) EPEQC=EMAX-SEQC*(EMAX-EPO)/TU
  281. GOTO 70
  282. ENDIF
  283. C---------------------------------------------------------------------
  284. IF(SEQC.LE.TU) THEN
  285. CALL EPSEQU(EPEQC,SEQC,IPL0,ICAL,0,EX,RB,EPO1,EPO,EMAX)
  286. ENDIF
  287. C---------------------------------------------------------------------
  288. 70 CONTINUE
  289. EPEQC1=EPEQC
  290. SEQC1=SEQC
  291. C---------------------------------------------------------------------
  292. IF(EPEQC1.GE.(EMAX/1.03D0).AND.JFISU.EQ.0) THEN
  293. C ################################
  294. C * CE POINT VIENT DE ROMPRE *
  295. C ################################
  296. IPLA1=4
  297. GOTO 100
  298. ENDIF
  299. C---------------------------------------------------------------------
  300. EPSEQ1=EPEQC1
  301. EQSTR1=SEQC1
  302. 40 CONTINUE
  303. C---------------------------------------------------------------------
  304. DO 4 I=1,NSTRS
  305. SIGR(I)= S1(I)
  306. EPSR(I)= STRNR(I)
  307. 4 CONTINUE
  308. EPSPL=EPSEQ1-EQSTR1/EX
  309. C---------------------------------------------------------------------
  310. IF(IBB1.EQ.IELM1) THEN
  311. WRITE(*,405) JFISU,IPLA1,EQSTR1,EPSEQ1
  312. 405 FORMAT('FIN JFISU=',I1,' IPLA1=',I1,' SEQC=',E9.3,' EPEQC=',E9.3)
  313. WRITE(*,*) ' ** S1 / STRNR'
  314. WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(EPSR(IC),IC=1,NSTRS)
  315. WRITE(*,*) '====================================================='
  316. ENDIF
  317. C---------------------------------------------------------------------
  318. 1991 FORMAT(18(1X,E12.5))
  319. 109 FORMAT(7(6(1X,E12.5),/))
  320. 108 FORMAT(7(4(1X,I4),/))
  321. RETURN
  322. END
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  

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