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