Télécharger fispla.eso

Retour à la liste

Numérotation des lignes :

  1. C FISPLA SOURCE CB215821 16/04/21 21:16:51 8920
  2. C FISPLA SOURCE INSL 24/10/96
  3. SUBROUTINE FISPLA(EPSR,STRN,STRNR,SIGR,SIGM,S1,NSTRS,IFOUR,
  4. A ITES,XE,NBNN,MELE,wrk12)
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. C
  9. DIMENSION EPSR(6),STRN(NSTRS),SIGM(NSTRS),S1(NSTRS),STRNR(6)
  10. DIMENSION SIGR(6),XE(3,NBNN),ST0X(6),SI0X(6)
  11. DIMENSION ST(3),ST0(3),SI0(3),SI(3),DSI(3),DSI0X(6),DST(3)
  12. C
  13. segment wrk12
  14. real*8 AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX
  15. real*8 EPSU,FTC,EPO,EPO1,ENGF,RMOY,PHIF,TEMP0
  16. real*8 DTEMP1,TEMP1,POAR,SCT,TETA,RMT1,RMT2,EDC1
  17. real*8 EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1
  18. real*8 TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1
  19. real*8 EQSTR2,EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3
  20. real*8 RTM3,EDC3,ETS3,EDT3,OUV3,TANG3
  21. integer ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2
  22. integer IFISU1,JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1
  23. endsegment
  24. * COMMON /CINSA/ AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX,EPSU,FTC,EPO,
  25. * 1 EPO1,ENGF,RMOY,PHIF,TEMP0,DTEMP1,TEMP1,POAR,SCT,TETA,
  26. * 2 RTM1,RTM2,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 * POINT DEJA FISSURE *
  35. C * COMPORTEMENT ELASTOPLASTIQUE *
  36. C ############################################
  37. C----------------------------------------------------------
  38. *
  39. * Calibrage de la deformation plastique et de la pente
  40. * poste pic : Gf
  41. *
  42. IF(ENGF.NE.0.D0) CALL LONCA(EX,RB,ALPHA,EPSU,XE,NBNN,ENGF,MELE)
  43. *
  44. TU=RB
  45. EB1=0.D0
  46. EB2=0.D0
  47. C----------------------------------------------------------
  48. CALL ZERO(ST0X,6,1)
  49. CALL ZERO(SI0X,6,1)
  50. CALL ZERO(DSI0X,6,1)
  51. CALL ZERO(SI,3,1)
  52. CALL ZERO(DSI,3,1)
  53. CALL ZERO(DST,3,1)
  54. C----------------------------------------------------------
  55. IF(ITES.EQ.1) SCT=0.D0
  56. DO 11 I=1,NSTRS
  57. DSI0X(I)=(1.D0-SCT)*SIGM(I)
  58. ST0X(I) =EPSR(I)+SCT*STRN(I)
  59. SI0X(I) =SIGR(I)+SCT*SIGM(I)
  60. 11 CONTINUE
  61. C
  62. IF(NSTRS.EQ.4.OR.NSTRS.EQ.6) THEN
  63. ST0X(3) =EPSR(4)+SCT*STRN(4)
  64. ST0X(4) =EPSR(3)+SCT*STRN(3)
  65. SI0X(3) =SIGR(4)+SCT*SIGM(4)
  66. SI0X(4) =SIGR(3)+SCT*SIGM(3)
  67. DSI0X(3)=(1.D0-SCT)*SIGM(4)
  68. DSI0X(4)=(1.D0-SCT)*SIGM(3)
  69. ENDIF
  70. C----------------------------------------------------------
  71. PHI=TETA-90.D0
  72. CALL CDRF(SI0X,PHI,SI0)
  73. CALL CDRF(DSI0X,PHI,DSI)
  74. CALL DDRF(ST0X,PHI,ST0)
  75. C----------------------------------------------------------
  76. IF(ITES.EQ.0) THEN
  77. ST0(1)=ST0(1)+PXY*SI0(2)/EX
  78. ST0(2)=ST0(2)+PXY*SI0(1)/EX
  79. ENDIF
  80. C----------------------------------------------------------
  81. C----------------------------------------------------------
  82. IPASN =0
  83. IELM1 =0
  84. C----------------------------------------------------------
  85. IF(IPASN.EQ.1.AND.IBB1.EQ.IELM1) THEN
  86. WRITE(*,*) '=========================================='
  87. & ,'=================================================='
  88. WRITE(*,*) '*** ST0X / SI0X '
  89. WRITE(*,1991) (ST0X(I),I=1,NSTRS),(SI0X(I),I=1,NSTRS)
  90. WRITE(*,*) ' ** SIGR / SIGM ITES =',ITES
  91. WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(SIGM(IC),IC=1,NSTRS)
  92. WRITE(*,*) '*** SI0 (AVANT DECHINT2) / ST0 RTM1=',RTM1
  93. & ,' TETA=',TETA,' SCALT=',SCT
  94. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  95. WRITE(*,1991) ((SI0(I),I=1,3),SI0X(4),ST0(J),J=1,3),ST0X(4)
  96. ELSE
  97. WRITE(*,1991) (SI0(I),I=1,3),(ST0(I),I=1,3)
  98. ENDIF
  99. ENDIF
  100. C----------------------------------------------------------
  101. C----------------------------------------------------------
  102. IF(ITES.EQ.0) THEN
  103. C----------------------------------------------------------
  104. C INITIALISATIONS POUR PLAEND
  105. TANG1=EX
  106. TANG2=EX
  107. CALL EPSEQU(EPST,FPT,0,ICAL,1,EX,RB,EPO1,EPO1,EMAX)
  108. EPST1= -1.D0*EPST
  109. EPST2= EPST1
  110. C
  111. JFISU=2
  112. JFISU2=0
  113. JFISU3=0
  114. IFISU1=0
  115. IFISU2=0
  116. IPLA1=0
  117. IPLA2=0
  118. EPSEQ1=0.D0
  119. EQSTR1=0.D0
  120. EDC1=0.D0
  121. EDT1=0.D0
  122. EPSC1=0.D0
  123. DEFR1=0.D0
  124. EPSEQ2=0.D0
  125. EQSTR2=0.D0
  126. EDC2=0.D0
  127. EDT2=0.D0
  128. EPSC2=0.D0
  129. DEFR2=0.D0
  130. ETS2 = 1.D+20
  131. RTM2 =FPT
  132. EEP2=RTM2/EX-EPSU
  133. IF(ABS(EEP2).GT.1.D-20) ETS2=ABS(RTM2/EEP2)
  134. ETS1=ETS2
  135. C
  136. C INITIALISATIONS DES VARIABLES INTERNES (DIRECTION 1)
  137. C
  138. CALL DECHIN(SI0(1),ST0(1),ETS1,EDC1,EPST1,IFISU1,JFISU,
  139. 1 RTM1,EPSC1,DEFR1,TANG1,IPLA1,EQSTR1,EPSEQ1,EX,RB,ALPHA,EPO1,
  140. 2 EMAX,ICAL,IBB1,IGAU1,1)
  141. C
  142. C INITIALISATIONS DES VARIABLES INTERNES (DIRECTION 2)
  143. C
  144. CALL DECHIN(SI0(2),ST0(2),ETS2,EDC2,EPST2,IFISU2,JFISU2,
  145. 1 RTM2,EPSC2,DEFR2,TANG2,IPLA2,EQSTR2,EPSEQ2,EX,RB,ALPHA,EPO1,
  146. 2 EMAX,ICAL,IBB1,IGAU1,2)
  147. C
  148. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  149. C
  150. C INITIALISATIONS DES VARIABLES INTERNES
  151. C (DIRECTION 3) EN DEFORMATION PLANES
  152. C
  153. EPST3 = -1.D0*EPST
  154. TANG3 =EX
  155. JFISU3=0
  156. IFISU3=0
  157. IPLA3 =0
  158. EPSEQ3=0.D0
  159. EQSTR3=0.D0
  160. EDC3 =0.D0
  161. EDT3 =0.D0
  162. EPSC3 =0.D0
  163. DEFR3 =0.D0
  164. RTM3 =FPT
  165. ETS3 =ETS2
  166. C
  167. IF(SI0X(4).LT.0.D0.AND.SI0X(4).GE.(-1.D0*RB)) THEN
  168. CALL EPSEQU(EPEQ4,ABS(SI0X(4)),0,ICAL,1,EX,RB,EPO1,EPO1,EMAX)
  169. ST0X(4) = -1.D0*EPEQ4
  170. ELSE
  171. ST0X(4) = SI0X(4)/EX
  172. ENDIF
  173. CALL DECHIN(SI0X(4),ST0X(4),ETS3,EDC3,EPST3,IFISU3,JFISU3,
  174. 1 RTM3,EPSC3,DEFR3,TANG3,IPLA3,EQSTR3,EPSEQ3,EX,RB,
  175. 2 ALPHA,EPO1,EMAX,ICAL,IBB1,IGAU1,3)
  176. C
  177. ENDIF
  178. SI0(3)=0.D0
  179. ENDIF
  180. C------------------------------------------------------------------
  181. C------------------------------------------------------------------
  182. IF(IPASN.EQ.1.AND.IBB1.EQ.IELM1) THEN
  183. WRITE(*,404) JFISU,IFISU1,IPLA1,RTM1,ETS1,EDC1,EDT1,DEFR1,
  184. & EPST1,EPSC1,EQSTR1,EPSEQ1
  185. WRITE(*,405) JFISU2,IFISU2,IPLA2,RTM2,ETS2,EDC2,EDT2,DEFR2,
  186. & EPST2,EPSC2,EQSTR2,EPSEQ2
  187. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  188. WRITE(*,406) JFISU3,IFISU3,IPLA3,RTM3,ETS3,EDC3,EDT3,DEFR3,
  189. & EPST3,EPSC3,EQSTR3,EPSEQ3
  190. ENDIF
  191. 404 FORMAT('AVANT JFISU1=',I1,' IFISU1=',I1,' IPLA1=',I1,' RTM1=',
  192. * E9.3,' ETS1=',E9.3,' EDC1=',E9.3,' EDT1=',E9.3,' DEFR1=',E9.3,
  193. * ' EPST1=',E9.3,' EPSC1=',E9.3,' EQSTR1=',E9.3,' EPSEQ1=',E9.3)
  194. 405 FORMAT('AVANT JFISU2=',I1,' IFISU2=',I1,' IPLA2=',I1,' RTM2=',
  195. * E9.3,' ETS2=',E9.3,' EDC2=',E9.3,' EDT2=',E9.3,' DEFR2=',E9.3,
  196. * ' EPST2=',E9.3,' EPSC2=',E9.3,' EQSTR2=',E9.3,' EPSEQ2=',E9.3)
  197. 406 FORMAT('AVANT JFISU3=',I1,' IFISU3=',I1,' IPLA3=',I1,' RTM3=',
  198. * E9.3,' ETS3=',E9.3,' EDC3=',E9.3,' EDT3=',E9.3,' DEFR3=',E9.3,
  199. * ' EPST3=',E9.3,' EPSC3=',E9.3,' EQSTR3=',E9.3,' EPSEQ3=',E9.3)
  200. WRITE(*,*) '*** ST0 (APRES DECHINT2) / SI0 '
  201. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  202. WRITE(*,1991) (ST0(I),I=1,3),ST0X(4),(SI0(I),I=1,3),SI0X(4)
  203. ELSE
  204. WRITE(*,1991) (ST0(I),I=1,3),(SI0(I),I=1,3)
  205. ENDIF
  206. ENDIF
  207. C------------------------------------------------------------------
  208. C------------------------------------------------------------------
  209. DST(1)=DSI(1)/EX
  210. DST(2)=DSI(2)/EX
  211. DST(3)=DSI(3)*2.D0*(1.D0+PXY)/EX
  212. C
  213. ST(1)=ST0(1)+DST(1)
  214. ST(2)=ST0(2)+DST(2)
  215. ST(3)=ST0(3)+DST(3)
  216. C------------------------------------------------------------------
  217. PENT=ETS1
  218. SIGMRX=SI0(1)+DSI(1)
  219. CALL PLAEND(ST0(1),SI0(1),DST(1),SI(1),IFISU1,IPLA1,EQSTR1,
  220. 1 EPSEQ1,JFISU,TANG1,EPST1,EPSC1,EDC1,EDT1,RTM1,DEFR1,SIGMRX,
  221. 2 ETS1,EX,RB,ALPHA,EMAX,EPSU,EPO1,ICAL,IBB1,IGAU1,1)
  222. C
  223. SIGMRX=SI0(2)+DSI(2)
  224. PENT=ETS2
  225. CALL PLAEND(ST0(2),SI0(2),DST(2),SI(2),IFISU2,IPLA2,EQSTR2,
  226. 1 EPSEQ2,JFISU2,TANG2,EPST2,EPSC2,EDC2,EDT2,RTM2,DEFR2,SIGMRX,
  227. 2 ETS2,EX,RB,ALPHA,EMAX,EPSU,EPO1,ICAL,IBB1,IGAU1,2)
  228. C------------------------------------------------------------------
  229. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  230. SIGMRX=SI0X(4)+DSI0X(4)
  231. DST4 =DSI0X(4)/EX
  232. ST4 =ST0X(4)+DST4
  233. PENT =ETS3
  234. CALL PLAEND(ST0X(4),SI0X(4),DST4,SI4,IFISU3,IPLA3,EQSTR3,
  235. 1 EPSEQ3,JFISU3,TANG3,EPST3,EPSC3,EDC3,EDT3,RTM3,DEFR3,SIGMRX,
  236. 2 ETS3,EX,RB,ALPHA,EMAX,EPSU,EPO1,ICAL,IBB1,IGAU1,3)
  237. ENDIF
  238. C------------------------------------------------------------------
  239. C------------------------------------------------------------------
  240. IF(IPASN.EQ.1.AND.IBB1.EQ.IELM1) THEN
  241. WRITE(*,*) '*** ST (APRES PLAEND2) / SI '
  242. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  243. WRITE(*,1991) (ST(I),I=1,3),ST4,(SI(I),I=1,3),SI4
  244. ELSE
  245. WRITE(*,1991) (ST(I),I=1,3),(SI(I),I=1,3)
  246. ENDIF
  247. C
  248. WRITE(*,401) JFISU,IFISU1,IPLA1,RTM1,ETS1,EDC1,EDT1,DEFR1,
  249. & EPST1,EPSC1,EQSTR1,EPSEQ1
  250. WRITE(*,403) JFISU2,IFISU2,IPLA2,RTM2,ETS2,EDC2,EDT2,DEFR2,
  251. & EPST2,EPSC2,EQSTR2,EPSEQ2
  252. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  253. WRITE(*,402) JFISU3,IFISU3,IPLA3,RTM3,ETS3,EDC3,EDT3,DEFR3,
  254. & EPST3,EPSC3,EQSTR3,EPSEQ3
  255. ENDIF
  256. 401 FORMAT('APRES JFISU1=',I1,' IFISU1=',I1,' IPLA1=',I1,' RTM1=',
  257. * E9.3,' ETS1=',E9.3,' EDC1=',E9.3,' EDT1=',E9.3,' DEFR1=',E9.3,
  258. * ' EPST1=',E9.3,' EPSC1=',E9.3,' EQSTR1=',E9.3,' EPSEQ1=',E9.3)
  259. 403 FORMAT('APRES JFISU2=',I1,' IFISU2=',I1,' IPLA2=',I1,' RTM2=',
  260. * E9.3,' ETS2=',E9.3,' EDC2=',E9.3,' EDT2=',E9.3,' DEFR2=',E9.3,
  261. * ' EPST2=',E9.3,' EPSC2=',E9.3,' EQSTR2=',E9.3,' EPSEQ2=',E9.3,/)
  262. 402 FORMAT('APRES JFISU3=',I1,' IFISU3=',I1,' IPLA3=',I1,' RTM3=',
  263. * E9.3,' ETS3=',E9.3,' EDC3=',E9.3,' EDT3=',E9.3,' DEFR3=',E9.3,
  264. * ' EPST3=',E9.3,' EPSC3=',E9.3,' EQSTR3=',E9.3,' EPSEQ3=',E9.3,/)
  265. ENDIF
  266. C------------------------------------------------------------------
  267. C------------------------------------------------------------------
  268. C Calcul des ouvertures de fissure dir. 1 et dir. 2
  269. C-----------------------------------------------------------------
  270. IF(IFISU1.EQ.1) THEN
  271. OUV1=ST(1)-DEFR1-EPSU
  272. IF(OUV1.LT.0.D0) OUV1=0.D0
  273. ENDIF
  274. IF(IFISU2.EQ.1) THEN
  275. OUV2=ST(2)-DEFR2-EPSU
  276. IF(OUV2.LT.0.D0) OUV2=0.D0
  277. ENDIF
  278. C------------------------------------------------------------------
  279. c++mdj
  280. ALRT1 = 2.D0 * EPSU
  281. ALRT2 = 4.D0 * EPSU
  282. c++mdj
  283. IF(OUV1.GT.ALRT1.OR.OUV2.GT.ALRT1) FTC =0.D0
  284. c++mdj
  285. C!! IF(OUV1.GT.ALRT2.OR.OUV2.GT.ALRT2) SI0(3)=0.D0
  286. c++mdj
  287. * IF(FTC.EQ.0.D0) WRITE(*,407) IBB1,IGAU1,OUV1,OUV2,ALRT1,ALRT2
  288. *407 FORMAT('IB =',I3,'IGAU =',I2,' OUV1=',E9.3,' OUV2=',E9.3,
  289. * & ' ALRT1=',E9.3,' ALRT2=',E9.3)
  290. C
  291. D33=EX/(1.D0+PXY)/2.D0
  292. SI(3)=SI0(3)+FTC*D33*DST(3)
  293. C-------------------------------------------------------------------
  294. CALL DDRG(ST,PHI,STRNR)
  295. CALL CDRG(SI,PHI,S1)
  296. IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
  297. STRNR(4)=STRNR(3)
  298. STRNR(3)=ST4
  299. S1(4) =S1(3)
  300. S1(3) =SI4
  301. ENDIF
  302. C-------------------------------------------------------------------
  303. C-------------------------------------------------------------------
  304. 1991 FORMAT(18(1X,E12.5))
  305. 1000 CONTINUE
  306. C-------------------------------------------------------------------
  307. RETURN
  308. END
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  

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