1 : C BETDJE SOURCE CHAT 09/01/27 21:15:00 6265 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 : FPT=ALPHA*RB 60 : SEQC1=0.D0 61 : EPEQC=0.D0 62 : C---------------------------------------------------------------------- 63 : C---------------------------------------------------------------------- 64 : IPASN = 0 65 : IELM1 = 0 66 : C---------------------------------------------------------------------- 67 : C---------------------------------------------------------------------- 67 : CALL ZERO(SIGMR,6,1) 67 : CALL ZERO(STRNR,6,1) 67 : CALL ZERO(SIGM,NSTRS,1) 67 : CALL ZERO(S1,6,1) 67 : CALL ZERO(S2,6,1) 67 : CALL ZERO(V1,4,1) 67 : CALL ZERO(EPFLT,NSTRS,1) 68 : C 68 : CALL MATHOO(D,EX,PXY,NSTRS,IFOUB) 68 : CALL BST(D,STRN,NSTRS,NSTRS,SIGM) 69 : C--------------------------------------------------------------------- 70 : DO 1 I=1,NSTRS 71 : S1(I)=SIGR(I)+SIGM(I) 72 : SIGMR(I)=S1(I) 73 : 1 CONTINUE 74 : C----------------------------------------------------------------- 75 : * APPELE EVENTUEL A UN MODELE DE FLUAGE POUR LE BETON 76 : * 77 : IF(IFLU.NE.0) THEN 77 : CALL MATSOU(D1,EX,PXY,NSTRS,IFOUB) 77 : CALL MOBFLU(SIGR,EPFLT,D1,NSTRS,IFLU,RMOY,PHIF,TEMP0, 78 : & DTEMP1,TEMP1,POAR) 79 : ENDIF 80 : C----------------------------------------------------------------- 81 : DO I=1,NSTRS 82 : IF(JFISU.EQ.0) THEN 83 : S2(I)=EPSR(I)+STRN(I)+EPFLT(I) 84 : ELSE 85 : S2(I)=EPSR(I)+STRN(I)+EPFLT(I)-EPFL0(I) 86 : ENDIF 87 : STRNR(I)=S2(I) 88 : END DO 89 : C--------------------------------------------------------------------- 89 : CALL CRIOTO(SIGMR,SEQB,FCRIB,NSTRS,TU,AA,BB,DK1,DK2) 90 : C---------------------------------------------------------------------- 91 : IF(IBB1.EQ.IELM1) THEN 92 : WRITE(*,*) '==========================================' 93 : & ,'==================================================' 94 : DEPEQ=(SEQB-EQSTR1)*(1.D0-2.D0*PXY)/EX 95 : EPEQC=EPSEQ1+DEPEQ 96 : EPOT=FPT/EX 97 : * 98 : WRITE(*,94) IBB1,IGAU1,ICU,ICAL,ILOI,IOUV 99 : 94 FORMAT('ELEM=',I3,' GAUSS=',I2,' ICU=',I1,' ICAL=',I1,' ILOI=',I1 100 : & ,' IOUV=',I2) 101 : WRITE(*,404) JFISU,IPLA1,IFLU,EQSTR1,EPSEQ1,SEQB,EPEQC,EPOT,EPO 102 : * 103 : WRITE(*,*) ' ** SIGR / EPSR ' 104 : WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(EPSR(IC),IC=1,NSTRS) 105 : WRITE(*,*) ' ** SIGM / STRN ' 106 : WRITE(*,1991) (SIGM(IC),IC=1,NSTRS),(STRN(IC),IC=1,NSTRS) 107 : WRITE(*,*) ' ** SIGMR / STRNR ' 108 : WRITE(*,1991) (SIGMR(IC),IC=1,NSTRS),(STRNR(IC),IC=1,NSTRS) 109 : 404 FORMAT('JFISU=',I2,'IPLA1=',I2,'IFLU=',I2,'SEQ0=',E9.3,' EPEQ0=' 110 : * ,E9.3,' SEQB=',E9.3,' EPEQC=',E9.3,' EPOT=',E9.3,' EPOC=',E9.3) 111 : ENDIF 112 : C--------------------------------------------------------------------- 113 : C--------------------------------------------------------------------- 114 : IF(IFLU.EQ.10.OR.IFLU.EQ.20.OR.IFLU.EQ.30) GOTO 40 115 : IF(JFISU.NE.0) GOTO 200 116 : IF(IPLA1.EQ.4) GOTO 100 117 : C-------------------------------------------------------------------- 118 : IF(SEQB .LE. EQSTR1) THEN 119 : C ############################## 120 : C * DECHARGE ELASTIQUE * 121 : C ############################## 122 : IPLA2=1 123 : GOTO 40 124 : ENDIF 125 : C-------------------------------------------------------------------- 126 : C ------------------------------------------------- 127 : C * ON CALCUL LA DEFORMATION EQUIVALENTE ACTUELLE * 128 : C ------------------------------------------------- 129 : DEPEQ=(SEQB-EQSTR1)*(1.D0-2.D0*PXY)/EX 130 : EPEQC=EPSEQ1+DEPEQ 131 : C--------------------------------------------------------------------- 132 : C ------------------------------------------------- 133 : C * ON CALCUL LA CONTRAINTE EQUIVALENTE ACTUELLE * 134 : C ------------------------------------------------- 135 : IPLC=0 136 : IF(IPLA1.GE.2.OR.EPEQC.GE.EPO) IPLC=1 137 : IF(ICAL.EQ.0) THEN 137 : CALL CDCY(EPEQC,SEQC,IPLC,EBC11,EX,TU,EMAX,EPO,ICAL) 138 : ELSE 139 : IF(IPLC.NE.0) THEN 140 : EBC11=-TU/(EMAX-EPO) 141 : SEQC=TU*(EMAX-EPEQC)/(EMAX-EPO) 142 : ELSE 143 : EBC11=EX 144 : SEQC=EPEQC*EX 145 : ENDIF 146 : ENDIF 147 : C--------------------------------------------------------------------- 148 : IF(IPLA2.EQ.1) THEN 149 : C ######################################### 150 : C * POINT INITIALEMENT EN DECHARGE * 151 : C ######################################### 152 : C 152 : CALL CRIOTO(SIGR,SEQ01,FCRIB,NSTRS,TU,AA,BB,DK1,DK2) 153 : IF(SEQ01.GT.TU) SEQ01=TU 154 : SEQ0 =SEQ01 155 : EET1 =EPSEQ1-EQSTR1/EX 156 : EPEQ0=SEQ0/EX+EET1 157 : ELSE 158 : EPEQ0=EPSEQ1 159 : SEQ0 =EQSTR1 160 : ENDIF 161 : IPLA2=0 162 : C--------------------------------------------------------------------- 163 : C ------------------------------- 164 : C * ON CALCUL LE MODULE SECANT * 165 : C ------------------------------- 166 : DEPEQ=EPEQC-EPEQ0 167 : IF(DABS(DEPEQ).LE.1.D-15) THEN 168 : EBC1=0.D0 169 : ELSE 170 : EBC1=(SEQC-SEQ0)/DEPEQ 171 : ENDIF 172 : C--------------------------------------------------------------------- 173 : EPEQC1=EPEQC 174 : SEQC1=SEQC 175 : C--------------------------------------------------------------------- 176 : 100 CONTINUE 177 : C--------------------------------------------------------------------- 178 : IF(IPLA1.EQ.4) THEN 179 : C ######################### 180 : C * POINT DEJA ROMPU * 181 : C ######################### 181 : CALL ZERO(D,NSTRS,NSTRS) 181 : CALL ZERO(S1,NSTRS,1) 182 : EQSTR1=0.D0 183 : EPSEQ1=EPEQC 184 : GOTO 40 185 : ENDIF 186 : C--------------------------------------------------------------------- 187 : IF(EPEQC1.GE.EMAX) THEN 188 : C ################################ 189 : C * CE POINT VIENT DE ROMPRE * 190 : C ################################ 191 : IPLA1=4 192 : GOTO 100 193 : ENDIF 194 : C--------------------------------------------------------------------- 195 : 200 CONTINUE 196 : C--------------------------------------------------------------------- 197 : IF(JFISU.NE.0) THEN 198 : C ##################################### 199 : C * POINT DEJA FISSURE * 200 : C * COMPORTEMENT ORTHOTROPE * 201 : C ##################################### 202 : C 202 : CALL FISPLA(EPSR,STRN,STRNR,SIGR,SIGM,S1,NSTRS,IFOUB,1, 203 : A XE,NBNN,MELE,wrk12) 204 : GOTO 40 205 : ENDIF 206 : C-------------------------------------------------------------------- 207 : IF(IPLA1.GE.2) THEN 208 : C ################################################### 209 : C * ECROUISSAGE NEGATIF (SOFTENING EN COMPRESSION) * 210 : C ################################################### 211 : C 211 : CALL CALPEC(IFOUB,STRN,SIGR,SIGM,S1,D,NSTRS,SEQC1,EBC1,EPEQC1 212 : 1 ,EPSR,STRNR,JFRIS,IPLA1,EPEQ0,SEQ0,XE,NBNN,MELE,EQSTR1,EPSEQ1, 213 : 2 AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12) 214 : IF(JFRIS.NE.0) GOTO 40 215 : GOTO 30 216 : ENDIF 217 : C--------------------------------------------------------------------- 218 : IF(IPLA1.EQ.0.AND.JFISU.EQ.0) THEN 219 : C ##################################### 220 : C * POINT INTEGRE * 221 : C ##################################### 222 : C 222 : CALL PINOTO(EPSR,STRN,STRNR,SIGR,SIGMR,SIGM,S1,V1,D,IPLA1, 223 : 1 JFRIS,NSTRS,IFOUB,EPEQC1,SEQC1,EBC1,EPEQ0,SEQ0,SEQB,XE,NBNN, 224 : 2 MELE,EQSTR1,EPSEQ1,AA,BB,DK1,DK2,ILOI,ALPHA,RB,EX,PXY,EPO,ICAL 225 : 3 , wrk12) 226 : C 227 : IF(JFRIS.NE.0) GOTO 40 228 : ENDIF 229 : C--------------------------------------------------------------------- 230 : 30 CONTINUE 231 : C================================================================== 231 : CALL CRIOTO(S1,SEQC,FCRIC,NSTRS,TU,AA,BB,DK1,DK2) 232 : IF(SEQC.GT.(1.0005D0*TU)) THEN 233 : C--------------------------------------------------------------------- 234 : DO 18 I=1,NSTRS 235 : S(I)=S1(I)-SIGR(I) 236 : 18 CONTINUE 237 : TETA0=TETA 238 : DTR10=DTR1 239 : DTR20=DTR2 240 : NOROU1=' BETDJE ' 240 : CALL SCALT(S,SIGR,S1,V1,SCT,NSTRS,DTAU,TU,AA,BB,DK1,DK2, 241 : & ALPHA,RB,DTR1,DTR2,TETA) 241 : CALL CRIOTO(S1,SEQC2,FCRIC,NSTRS,TU,AA,BB,DK1,DK2) 242 : TETA=TETA0 243 : DTR1=DTR10 244 : DTR2=DTR20 245 : SEQC=SEQC2 246 : IF(SEQC.GT.TU) SEQC=TU 247 : EPEQC=EPO 248 : C--------------------------------------------------------------------- 249 : ENDIF 250 : C================================================================== 251 : 71 CONTINUE 252 : C================================================================== 253 : IF(SEQC.GT.TU) SEQC=TU 254 : IPL0 = 0 255 : IF(IPLA1.NE.0.OR.JFISU.NE.0) IPL0 = 1 256 : C--------------------------------------------------------------------- 257 : IF(ICAL.EQ.1) THEN 258 : IF(IPL0.EQ.0) EPEQC=SEQC/EX 259 : IF(IPL0.NE.0) EPEQC=EMAX-SEQC*(EMAX-EPO)/TU 260 : GOTO 70 261 : ENDIF 262 : C--------------------------------------------------------------------- 263 : IF(SEQC.LE.TU) THEN 263 : CALL EPSEQU(EPEQC,SEQC,IPL0,ICAL,0,EX,RB,EPO1,EPO,EMAX) 264 : ENDIF 265 : C--------------------------------------------------------------------- 266 : 70 CONTINUE 267 : EPEQC1=EPEQC 268 : SEQC1=SEQC 269 : C--------------------------------------------------------------------- 270 : IF(EPEQC1.GE.(EMAX/1.03D0).AND.JFISU.EQ.0) THEN 271 : C ################################ 272 : C * CE POINT VIENT DE ROMPRE * 273 : C ################################ 274 : IPLA1=4 275 : GOTO 100 276 : ENDIF 277 : C--------------------------------------------------------------------- 278 : EPSEQ1=EPEQC1 279 : EQSTR1=SEQC1 280 : 40 CONTINUE 281 : C--------------------------------------------------------------------- 282 : DO 4 I=1,NSTRS 283 : SIGR(I)= S1(I) 284 : EPSR(I)= STRNR(I) 285 : 4 CONTINUE 286 : EPSPL=EPSEQ1-EQSTR1/EX 287 : C--------------------------------------------------------------------- 288 : IF(IBB1.EQ.IELM1) THEN 289 : WRITE(*,405) JFISU,IPLA1,EQSTR1,EPSEQ1 290 : 405 FORMAT('FIN JFISU=',I1,' IPLA1=',I1,' SEQC=',E9.3,' EPEQC=',E9.3) 291 : WRITE(*,*) ' ** S1 / STRNR' 292 : WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(EPSR(IC),IC=1,NSTRS) 293 : WRITE(*,*) '=====================================================' 294 : ENDIF 295 : C--------------------------------------------------------------------- 296 : 1991 FORMAT(18(1X,E12.5)) 297 : 109 FORMAT(7(6(1X,E12.5),/)) 298 : 108 FORMAT(7(4(1X,I4),/)) 299 : RETURN 300 : END 301 : 302 : 303 : 304 : 305 : 306 :
© Cast3M 2003 - All rights reserved.
Disclaimer