Télécharger la plaquette Cast3M


fr en

Télécharger betdje.eso

Retour à la liste

Numérotation des lignes : 

betdje

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

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