C BETDJE SOURCE CB215821 16/04/21 21:15:20 8920 C BETDJE SOURCE INSL 24/10/96 SUBROUTINE BETDJE(EPSR,SIGR,SIGM,NSTRS,D,D1,IFOUB,STRN,EPSPL, 1 EPFLT,EPFL0,XE,NBNN,MELE,wrk12) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*8 NOROU1 DIMENSION SIGR(6),SIGMR(6),S1(6),STRNR(6),SIGM(NSTRS) DIMENSION EPSR(6),D1(NSTRS,NSTRS),S2(6),D(NSTRS,NSTRS),V1(4) DIMENSION STRN(NSTRS),S(6),EPFLT(NSTRS),EPFL0(NSTRS),XE(3,NBNN) segment wrk12 real*8 AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX real*8 EPUT,FTC,EPO,EPO1,ENGF,RMOY,PHIF,TEMP0 real*8 DTEMP1,TEMP1,POAR,SCT,TETA,DTR1,DTR2,EDC1 real*8 EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1 real*8 TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1 real*8 EQSTR2,EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3 real*8 RTM3,EDC3,ETS3,EDT3,OUV3,TANG3 integer ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2 integer IFISU1,JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1 endsegment * * COMMON /CINSA/ AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX,EPUT,FTC,EPO, * 1 EPO1,ENGF,RMOY,PHIF,TEMP0,DTEMP1,TEMP1,POAR,SCT,TETA, * 2 DTR1,DTR2,EDC1,EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1, * 3 TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1,EQSTR2, * 4 EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3,RTM3,EDC3, * 5 ETS3,EDT3,OUV3,TANG3, * 6 ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2,IFISU1, * 7 JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1 C C--------------------------------------------------------------------- C ************************************************************ C * APPLICATION DES CRITERES DE PLASTICITE ET FISSURATION * C * CRITERE BETON D'OTTOSEN * C * * C * JFISU=INDICE DE FISSURATION * C * =0 PAS DE FISSURE * C * =1 UNE FISSURE * C * =2 RUPTURE TRACTION (sigma=0, epsilon > epsut)* C * * C * IPLA1=INDICE DE PLASTICITE * C * =0 ECROUISSAGE POSITIF * C * =2 ECROUISSAGE NEGATIF OU PALIER PLASTIQUE * C * =3 RUPTURE PAR COMPRESSION DANS 1 DIRECTION * C * =4 POINT BIAXIALEMENT ROMPU * C * * C ************************************************************ C * IFLU = 0 : PAS DE FLUAGE * IFLU = 10 : FLUAGE (BPEL91_K(t)=2) + BETON ELASTIQUE * IFLU = 11 : FLUAGE (BPEL91_K(t)=2) + BETON ELASTOPLASTIQUE * IFLU = 20 : FLUAGE (BPEL91_K(t)..) + BETON ELASTIQUE * IFLU = 21 : FLUAGE (BPEL91_K(t)..) + BETON ELASTOPLASTIQUE C--------------------------------------------------------------------- JFRIS=0 TU=RB FPT=ALPHA*RB SEQC1=0.D0 EPEQC=0.D0 C---------------------------------------------------------------------- C---------------------------------------------------------------------- IPASN = 0 IELM1 = 0 C---------------------------------------------------------------------- C---------------------------------------------------------------------- CALL ZERO(SIGMR,6,1) CALL ZERO(STRNR,6,1) CALL ZERO(SIGM,NSTRS,1) CALL ZERO(S1,6,1) CALL ZERO(S2,6,1) CALL ZERO(V1,4,1) CALL ZERO(EPFLT,NSTRS,1) C CALL MATHOO(D,EX,PXY,NSTRS,IFOUB) CALL BST(D,STRN,NSTRS,NSTRS,SIGM) C--------------------------------------------------------------------- DO 1 I=1,NSTRS S1(I)=SIGR(I)+SIGM(I) SIGMR(I)=S1(I) 1 CONTINUE C----------------------------------------------------------------- * APPELE EVENTUEL A UN MODELE DE FLUAGE POUR LE BETON * IF(IFLU.NE.0) THEN CALL MATSOU(D1,EX,PXY,NSTRS,IFOUB) CALL MOBFLU(SIGR,EPFLT,D1,NSTRS,IFLU,RMOY,PHIF,TEMP0, & DTEMP1,TEMP1,POAR) ENDIF C----------------------------------------------------------------- DO I=1,NSTRS IF(JFISU.EQ.0) THEN S2(I)=EPSR(I)+STRN(I)+EPFLT(I) ELSE S2(I)=EPSR(I)+STRN(I)+EPFLT(I)-EPFL0(I) ENDIF STRNR(I)=S2(I) END DO C--------------------------------------------------------------------- CALL CRIOTO(SIGMR,SEQB,FCRIB,NSTRS,TU,AA,BB,DK1,DK2) C---------------------------------------------------------------------- IF(IBB1.EQ.IELM1) THEN WRITE(*,*) '==========================================' & ,'==================================================' DEPEQ=(SEQB-EQSTR1)*(1.D0-2.D0*PXY)/EX EPEQC=EPSEQ1+DEPEQ EPOT=FPT/EX * WRITE(*,94) IBB1,IGAU1,ICU,ICAL,ILOI,IOUV 94 FORMAT('ELEM=',I3,' GAUSS=',I2,' ICU=',I1,' ICAL=',I1,' ILOI=',I1 & ,' IOUV=',I2) WRITE(*,404) JFISU,IPLA1,IFLU,EQSTR1,EPSEQ1,SEQB,EPEQC,EPOT,EPO * WRITE(*,*) ' ** SIGR / EPSR ' WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(EPSR(IC),IC=1,NSTRS) WRITE(*,*) ' ** SIGM / STRN ' WRITE(*,1991) (SIGM(IC),IC=1,NSTRS),(STRN(IC),IC=1,NSTRS) WRITE(*,*) ' ** SIGMR / STRNR ' WRITE(*,1991) (SIGMR(IC),IC=1,NSTRS),(STRNR(IC),IC=1,NSTRS) 404 FORMAT('JFISU=',I2,'IPLA1=',I2,'IFLU=',I2,'SEQ0=',E9.3,' EPEQ0=' * ,E9.3,' SEQB=',E9.3,' EPEQC=',E9.3,' EPOT=',E9.3,' EPOC=',E9.3) ENDIF C--------------------------------------------------------------------- C--------------------------------------------------------------------- IF(IFLU.EQ.10.OR.IFLU.EQ.20.OR.IFLU.EQ.30) GOTO 40 IF(JFISU.NE.0) GOTO 200 IF(IPLA1.EQ.4) GOTO 100 C-------------------------------------------------------------------- IF(SEQB .LE. EQSTR1) THEN C ############################## C * DECHARGE ELASTIQUE * C ############################## IPLA2=1 GOTO 40 ENDIF C-------------------------------------------------------------------- C ------------------------------------------------- C * ON CALCUL LA DEFORMATION EQUIVALENTE ACTUELLE * C ------------------------------------------------- DEPEQ=(SEQB-EQSTR1)*(1.D0-2.D0*PXY)/EX EPEQC=EPSEQ1+DEPEQ C--------------------------------------------------------------------- C ------------------------------------------------- C * ON CALCUL LA CONTRAINTE EQUIVALENTE ACTUELLE * C ------------------------------------------------- IPLC=0 IF(IPLA1.GE.2.OR.EPEQC.GE.EPO) IPLC=1 IF(ICAL.EQ.0) THEN CALL CDCY(EPEQC,SEQC,IPLC,EBC11,EX,TU,EMAX,EPO,ICAL) ELSE IF(IPLC.NE.0) THEN EBC11=-TU/(EMAX-EPO) SEQC=TU*(EMAX-EPEQC)/(EMAX-EPO) ELSE EBC11=EX SEQC=EPEQC*EX ENDIF ENDIF C--------------------------------------------------------------------- IF(IPLA2.EQ.1) THEN C ######################################### C * POINT INITIALEMENT EN DECHARGE * C ######################################### C CALL CRIOTO(SIGR,SEQ01,FCRIB,NSTRS,TU,AA,BB,DK1,DK2) IF(SEQ01.GT.TU) SEQ01=TU SEQ0 =SEQ01 EET1 =EPSEQ1-EQSTR1/EX EPEQ0=SEQ0/EX+EET1 ELSE EPEQ0=EPSEQ1 SEQ0 =EQSTR1 ENDIF IPLA2=0 C--------------------------------------------------------------------- C ------------------------------- C * ON CALCUL LE MODULE SECANT * C ------------------------------- DEPEQ=EPEQC-EPEQ0 IF(ABS(DEPEQ).LE.1.D-15) THEN EBC1=0.D0 ELSE EBC1=(SEQC-SEQ0)/DEPEQ ENDIF C--------------------------------------------------------------------- EPEQC1=EPEQC SEQC1=SEQC C--------------------------------------------------------------------- 100 CONTINUE C--------------------------------------------------------------------- IF(IPLA1.EQ.4) THEN C ######################### C * POINT DEJA ROMPU * C ######################### CALL ZERO(D,NSTRS,NSTRS) CALL ZERO(S1,NSTRS,1) EQSTR1=0.D0 EPSEQ1=EPEQC GOTO 40 ENDIF C--------------------------------------------------------------------- IF(EPEQC1.GE.EMAX) THEN C ################################ C * CE POINT VIENT DE ROMPRE * C ################################ IPLA1=4 GOTO 100 ENDIF C--------------------------------------------------------------------- 200 CONTINUE C--------------------------------------------------------------------- IF(JFISU.NE.0) THEN C ##################################### C * POINT DEJA FISSURE * C * COMPORTEMENT ORTHOTROPE * C ##################################### C CALL FISPLA(EPSR,STRN,STRNR,SIGR,SIGM,S1,NSTRS,IFOUB,1, A XE,NBNN,MELE,wrk12) GOTO 40 ENDIF C-------------------------------------------------------------------- IF(IPLA1.GE.2) THEN C ################################################### C * ECROUISSAGE NEGATIF (SOFTENING EN COMPRESSION) * C ################################################### C CALL CALPEC(IFOUB,STRN,SIGR,SIGM,S1,D,NSTRS,SEQC1,EBC1,EPEQC1 1 ,EPSR,STRNR,JFRIS,IPLA1,EPEQ0,SEQ0,XE,NBNN,MELE,EQSTR1,EPSEQ1, 2 AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12) IF(JFRIS.NE.0) GOTO 40 GOTO 30 ENDIF C--------------------------------------------------------------------- IF(IPLA1.EQ.0.AND.JFISU.EQ.0) THEN C ##################################### C * POINT INTEGRE * C ##################################### C CALL PINOTO(EPSR,STRN,STRNR,SIGR,SIGMR,SIGM,S1,V1,D,IPLA1, 1 JFRIS,NSTRS,IFOUB,EPEQC1,SEQC1,EBC1,EPEQ0,SEQ0,SEQB,XE,NBNN, 2 MELE,EQSTR1,EPSEQ1,AA,BB,DK1,DK2,ILOI,ALPHA,RB,EX,PXY,EPO,ICAL 3 , wrk12) C IF(JFRIS.NE.0) GOTO 40 ENDIF C--------------------------------------------------------------------- 30 CONTINUE C================================================================== CALL CRIOTO(S1,SEQC,FCRIC,NSTRS,TU,AA,BB,DK1,DK2) IF(SEQC.GT.(1.0005D0*TU)) THEN C--------------------------------------------------------------------- DO 18 I=1,NSTRS S(I)=S1(I)-SIGR(I) 18 CONTINUE TETA0=TETA DTR10=DTR1 DTR20=DTR2 NOROU1=' BETDJE ' CALL SCALT(S,SIGR,S1,V1,SCT,NSTRS,DTAU,TU,AA,BB,DK1,DK2, & ALPHA,RB,DTR1,DTR2,TETA) CALL CRIOTO(S1,SEQC2,FCRIC,NSTRS,TU,AA,BB,DK1,DK2) TETA=TETA0 DTR1=DTR10 DTR2=DTR20 SEQC=SEQC2 IF(SEQC.GT.TU) SEQC=TU EPEQC=EPO C--------------------------------------------------------------------- ENDIF C================================================================== 71 CONTINUE C================================================================== IF(SEQC.GT.TU) SEQC=TU IPL0 = 0 IF(IPLA1.NE.0.OR.JFISU.NE.0) IPL0 = 1 C--------------------------------------------------------------------- IF(ICAL.EQ.1) THEN IF(IPL0.EQ.0) EPEQC=SEQC/EX IF(IPL0.NE.0) EPEQC=EMAX-SEQC*(EMAX-EPO)/TU GOTO 70 ENDIF C--------------------------------------------------------------------- IF(SEQC.LE.TU) THEN CALL EPSEQU(EPEQC,SEQC,IPL0,ICAL,0,EX,RB,EPO1,EPO,EMAX) ENDIF C--------------------------------------------------------------------- 70 CONTINUE EPEQC1=EPEQC SEQC1=SEQC C--------------------------------------------------------------------- IF(EPEQC1.GE.(EMAX/1.03D0).AND.JFISU.EQ.0) THEN C ################################ C * CE POINT VIENT DE ROMPRE * C ################################ IPLA1=4 GOTO 100 ENDIF C--------------------------------------------------------------------- EPSEQ1=EPEQC1 EQSTR1=SEQC1 40 CONTINUE C--------------------------------------------------------------------- DO 4 I=1,NSTRS SIGR(I)= S1(I) EPSR(I)= STRNR(I) 4 CONTINUE EPSPL=EPSEQ1-EQSTR1/EX C--------------------------------------------------------------------- IF(IBB1.EQ.IELM1) THEN WRITE(*,405) JFISU,IPLA1,EQSTR1,EPSEQ1 405 FORMAT('FIN JFISU=',I1,' IPLA1=',I1,' SEQC=',E9.3,' EPEQC=',E9.3) WRITE(*,*) ' ** S1 / STRNR' WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(EPSR(IC),IC=1,NSTRS) WRITE(*,*) '=====================================================' ENDIF C--------------------------------------------------------------------- 1991 FORMAT(18(1X,E12.5)) 109 FORMAT(7(6(1X,E12.5),/)) 108 FORMAT(7(4(1X,I4),/)) RETURN END