Télécharger la plaquette Cast3M


fr en

Télécharger bone.eso

Retour à la liste

Numérotation des lignes : 

bone

  1. C BONE      SOURCE    CB215821  26/08/24    21:15:17     12622          
  2.       SUBROUTINE BONE(SIGR,SIGF,DSTRN,IPLA,IFISU,SIG1,SIG2
  3.      A  ,NSTRS,D,D1,IFOUB,SIGP,EPST,SIR,SIRL,ENDO
  4.      B  ,ITHHER,T0,TF,BETJEF,VISCO,BETFLU
  5.      B  ,NECH0,NECH1,NECH2,NECH3)
  6. C
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9.       DIMENSION SIGR(4),DSIGT(4),SIGF(4),S1(4),DSTRN(4),SIGT(4)
  10.       DIMENSION EPSR(9),S2(4),V2(4),V1(4)
  11.       DIMENSION S(6),SI1(6),EPST(4),SIGRV(4)
  12.       DIMENSION ST0(6),V02(4),SI0(6),V01(4),SIGP(4)
  13.       DIMENSION SIGIST(4),EXU(9),CODU(9,9),COD(8),TZU(19),EXUL(8)
  14.       DIMENSION STRNI(9),SOM(9),DEFMAX(9),DDSTRN(9)
  15.       DIMENSION H(4,4),DSTFL(4),S3(4)
  16.       DIMENSION DEP(4,4),D1(4,4),D(4,4),SIRL(8,4),SIR(9,4)
  17.       DIMENSION DEPE(4,4),DH(4,4),HI(4,4),CODL(8,8)
  18. *
  19.       SEGMENT BETJEF
  20.        REAL*8 AA,BETA,RB,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
  21.      &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  22.        INTEGER ICT,ICC,IMOD,IVIS,ITER,
  23.      &                ISIM,IBB,IGAU,IZON
  24.       ENDSEGMENT
  25.       SEGMENT VISCO
  26.        REAL*8 DPSTV1,DPSTV2,SIGV1,SIGV2,ENDV
  27.       ENDSEGMENT
  28.       SEGMENT BETFLU
  29.        REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  30.      &         TP0,TZER
  31.        INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
  32.       ENDSEGMENT
  33.       SEGMENT NECH0
  34.        REAL*8 DT,DC,ALFG,S0,ENDO
  35.       ENDSEGMENT
  36.       SEGMENT NECH1
  37.        REAL*8 DLMT
  38.       ENDSEGMENT
  39.       SEGMENT NECH2
  40.        REAL*8 ATR,GTR,ALPH0
  41.       ENDSEGMENT
  42.       SEGMENT NECH3
  43.        REAL*8 RBT,ALFAT,YOUNT,GFCT,GFTT,ALPH
  44.       ENDSEGMENT
  45. C
  46.       TAU1=0.05
  47.       NTPS=18
  48.       NTZERO=18
  49.       NCOE=8
  50.       MC=NBRC+1
  51.       NC=NCOE+1
  52. C
  53. C--------------------------------------------------------------------------
  54. C         ************************************************************
  55. C         *   APPLICATION DES CRITERES DE PLASTICITE ET FISSURATION  *
  56. C         *               CRITERE BETON                              *
  57. C         *                                                          *
  58. C         *       IFISU=INDICE DE FISSURATION                        *
  59. C         *            =0 PAS DE FISSURE                             *
  60. C         *            =1 UNE FISSURE                                *
  61. C         *            =2 RUINE DANS DIRECTION DE TRACTION           *
  62. C         *                                                          *
  63. C         *       IPLA =INDICE DE PLASTICITE                         *
  64. C         *            =0 ELASTIQUE                                  *
  65. C         *            =1 ECROUISSAGE POSITIF                        *
  66. C         *            =2 RUPTURE PAR COMPRESSION DANS 1 DIRECTION   *
  67. C         *                                                          *
  68. C         *                                                          *
  69. C         *                                                          *
  70. C         ************************************************************
  71. C---------------------------------------------------------------------
  72.  
  73.       AA = 1.D0/3.D0
  74.       CALL ZERO(DSIGT,4,1)
  75.       CALL ZERO(SIGT,4,1)
  76.       CALL ZERO(SIGIST,4,1)
  77.       CALL ZERO(SIGRV,4,1)
  78.       CALL ZERO(CODU,9,9)
  79.       CALL ZERO(CODL,8,8)
  80.       CALL ZERO(COD,8,1)
  81.       CALL ZERO(S1,4,1)
  82.       CALL ZERO(S2,4,1)
  83.       CALL ZERO(V1,4,1)
  84.       CALL ZERO(V2,4,1)
  85.       CALL ZERO(D,4,4)
  86.       CALL ZERO(DEP,4,4)
  87.       CALL ZERO(H,4,4)
  88.       CALL ZERO(HI,4,4)
  89.       DAM = 0.D0
  90. C
  91. C ****************** INITIALISATION POUR VISCOPLASTIQUE ***************
  92. C
  93.       IF (IVIS.EQ.1.OR.IVIS.EQ.4) THEN
  94.       DO 5 I=1,NSTRS
  95.         SIGRV(I)= SIGR(I)
  96.     5 CONTINUE
  97.       ENDIF
  98.       IF ((IVIS.EQ.1.AND.(IPLA.GT.0.OR.IFISU.GT.0)).OR.
  99.      &     (IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0))) THEN
  100. C
  101.       DO 6 I=1,NSTRS
  102.         SIGR(I)= SIGP(I)
  103.     6 CONTINUE
  104.       ENDIF
  105.       DO 7 I=1,NSTRS
  106.         SIGR(I)= SIGR(I)/(1.D0-ENDO)
  107.     7 CONTINUE
  108. C
  109. C ****************** INITIALISATION POUR VISCOELASTIQUE ***************
  110. C
  111.       IF (IVIS.EQ.2) THEN
  112.       SEL1=0.D0
  113.       SEL2=0.D0
  114.       EX=0.D0
  115.       TPS1 = TP0
  116.       TPS2 = TP0+PDT
  117.       ENDIF
  118. C
  119.       CALL INFICH(CODU,CODL,COD,BETJEF,BETFLU)
  120.       CALL MODBET(TPS1,TPS2,SEL1,SEL2,EXU,EXUL,EX,CODU,CODL
  121.      &            ,COD,BETJEF,BETFLU)
  122. C      WRITE(*,*)'EX=',EX,'a T=',TPS2
  123.       IF (IFOR.EQ.1) THEN
  124.       CALL CALIS1(SIGIST,NSTRS,DSTRN,IFOUB,SIR,CODU,CODL,
  125.      &     COD,BETJEF,BETFLU)
  126.       ENDIF
  127.       IF (IFOR.EQ.2) THEN
  128.       CALL CALIS2(SIGIST,NSTRS,DSTRN,IFOUB,SIRL,CODU,CODL,
  129.      &     COD,BETJEF,BETFLU)
  130.       ENDIF
  131. C
  132. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  133. C                INITIALISATION DE L'ENDOMMAGEMENT
  134. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  135.       IF(IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  136.        IF((IFISU.EQ.0.D0).AND.(IPLA.EQ.0.D0))THEN
  137.         ENDO=0.D0
  138.         DO 300 I =1, NSTRS
  139.         STRNI(I)=0.D0
  140.   300   CONTINUE
  141.        ENDIF
  142. C
  143.        DO 400 I=1, NSTRS
  144.        SOM(I)=SOM(I)+DSTRN(I)
  145.        DEFMAX(I)=MAX(ABS(SOM(I)),ABS(STRNI(I)))
  146.        DDSTRN(I)=ABS(SOM(I))-ABS(DEFMAX(I))
  147.   400  CONTINUE
  148.  
  149. C
  150.        DO 500 I=1, NSTRS
  151.        STRNI(I)=DEFMAX(I)
  152.   500  CONTINUE
  153. C
  154. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  155. C                   TEST SUR LE TYPE DE CHARGEMENT
  156. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  157. C
  158.        DO 200 I=1,NSTRS
  159.        IF (DDSTRN(I).LT.0.D0) THEN
  160.        DSTRN(I)=(1.D0-ENDO)*DSTRN(I)
  161.        ENDIF
  162.   200  CONTINUE
  163. C
  164. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  165. C           CALCUL DE LA MATRICE D'INTERACTION THERMO-MECA [H]
  166. C                          ET INVERSE DE [H]
  167. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  168. C
  169.        CALL INTERF(ITHHER,T0,TF,NSTRS,H,BETJEF,NECH2)
  170. C
  171. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  172. C           CALCUL DE LA DEFORMATION D'INTERACTION
  173. C                  THERMO-MECA [DSTFL]AU PAS N
  174. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  175. C
  176.        CALL TRANSI(ITHHER,T0,TF,NSTRS,HI,BETJEF,NECH2)
  177. C
  178.        DO 501 I=1,NSTRS
  179.        DSTFL(I)=0.D0
  180.        DO 250 J=1,NSTRS
  181.        DSTFL(I)=DSTFL(I)+HI(I,J)*SIGF(J)
  182.   250  CONTINUE
  183.   501  CONTINUE
  184. C
  185. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  186. C           CALCUL DE LA DEFORMATION DU TIRE ELASTIQUE
  187. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  188. C
  189.        DO 260 I=1,NSTRS
  190.        DSTRN(I)=DSTRN(I)-DSTFL(I)
  191.   260  CONTINUE
  192. C
  193. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  194. C
  195.        CALL INVMA2(H,NSTRS,ISING)
  196.        ENDIF
  197. C
  198. C ************************** CAS CONTRAINTE PLANE *********************
  199. C
  200.       IF (IFOUB.EQ.-2) THEN
  201.       IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  202.        CALL CREMAT(DH,EX,XNU,3,IFOUB)
  203.        CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS)
  204.       ELSE
  205.        CALL CREMAT(DEP,EX,XNU,3,IFOUB)
  206.       ENDIF
  207.       IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
  208.       CALL PROMA2(DEP,DSTRN,3,DSIGT)
  209.       DO 2 I=1,NSTRS
  210.          SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I)
  211.     2 CONTINUE
  212.       ENDIF
  213.       IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN
  214.       WRITE(*,*)'ATTENTION IMOD=2 ou 4 -> DEFORMATIONS PLANES'
  215.       STOP
  216.       ENDIF
  217.       ENDIF
  218. C
  219. C ***** CAS DEFORMATION PLANE ou AXISYMETRIQUE ***************
  220. C
  221.       IF (IFOUB.EQ.-1.OR.IFOUB.EQ.0) THEN
  222.       IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  223.        CALL CREMAT(DH,EX,XNU,4,IFOUB)
  224.        CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS)
  225.       ELSE
  226.        CALL CREMAT(DEP,EX,XNU,4,IFOUB)
  227.       ENDIF
  228.       CALL PROMA2(DEP,DSTRN,4,DSIGT)
  229.       DO 3 I=1,NSTRS
  230.          SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I)
  231.     3 CONTINUE
  232.       IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
  233.       WRITE(*,*)'ATTENTION IMOD=1 ou 3 -> CONTRAINTES PLANES'
  234.       STOP
  235.       ENDIF
  236.       ENDIF
  237. C
  238. C ************************ Normalisation *********************
  239. C
  240.       DO 1 I=1,NSTRS
  241.         IF(ABS(SIGR(I)).LT.1.D-6) SIGR(I)=0.D0
  242.         IF(ABS(SIGT(I)).LT.1.D-6) SIGT(I)=0.D0
  243.     1 CONTINUE
  244. C---------------------------------------------------------------------
  245.       DO 11 I=1,NSTRS
  246.         S1(I)=SIGT(I)
  247.    11 CONTINUE
  248.       CALL PRINC(S1,V1,NSTRS)
  249. C
  250. C **************** TEST DU TYPE DE SOLLICITATION *********************
  251. C
  252.       IZON=1
  253.       IF(V1(1).LT.0.D0.AND.V1(2).LT.0.D0) IZON=0
  254.       IF(V1(1).GE.0.D0.AND.V1(2).GE.0.D0) IZON=2
  255. C---------------------------------------------------------------------
  256. C      IF (IFISU.NE.0)  GOTO 15
  257.       IF (IZON.EQ.0)  GOTO 30
  258.       IF (IZON.EQ.1.OR.IZON.EQ.2) GOTO 15
  259. C
  260. C ******************** COMPORTEMENT DE TRACTION **********************
  261. C
  262.    15 CONTINUE
  263. C           #####################################
  264. C           *        POINT DEJA FISSURE         *
  265. C           *     COMPORTEMENT   PLASTIQUE      *
  266. C           #####################################
  267. C
  268.       IF(IFISU.NE.0) THEN
  269.         IF(IZON.EQ.2) THEN
  270.         CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  271.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  272.      A  BETJEF,VISCO,NECH0,NECH1)
  273.              GOTO 40
  274.         ENDIF
  275.         IF(IZON.EQ.1) THEN
  276.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  277.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  278.      A  BETJEF,VISCO,NECH0,NECH1)
  279.              GOTO 40
  280.         ENDIF
  281.         IF(IZON.EQ.0) THEN
  282.       WRITE(*,*)'Dans elasbet un point deja fissure est teste en
  283.      *bicompression'
  284.       WRITE(*,*)'Element num:',IBB ,'au point de Gauss num:',IGAU
  285.       STOP
  286.         ENDIF
  287.       ENDIF
  288. C---------------------------------------------------------------------
  289. C           #####################################
  290. C           *     POINT  FISSURE 1ER FOIS       *
  291. C           *     COMPORTEMENT   PLASTIQUE      *
  292. C           #####################################
  293. C
  294.       Ft=ALPHA*RB
  295.       IF(V1(1).GT.Ft) THEN
  296.         IF(IZON.EQ.2) THEN
  297.         CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  298.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  299.      A  BETJEF,VISCO,NECH0,NECH1)
  300.              GOTO 40
  301.         ENDIF
  302.         IF(IZON.EQ.1) THEN
  303.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  304.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  305.      A  BETJEF,VISCO,NECH0,NECH1)
  306.              GOTO 40
  307.         ENDIF
  308.       ENDIF
  309.       IF(IZON.EQ.1.AND.IPLA.EQ.0) THEN
  310.        IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  311.         CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  312.        ENDIF
  313.        IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  314.         CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  315.        ENDIF
  316.         FCRI=SEQ-RB*AA
  317.         IF(FCRI.GT.0.D0) THEN
  318.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  319.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  320.      A  BETJEF,VISCO,NECH0,NECH1)
  321.              GOTO 40
  322.         ENDIF
  323.       ENDIF
  324.       IF(IZON.EQ.1.AND.IPLA.GE.1) THEN
  325.        IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  326.         CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  327.        ENDIF
  328.        IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  329.         CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  330.        ENDIF
  331.         FCRI=SEQ-SIG2
  332.         IF(FCRI.GT.0.D0) THEN
  333.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  334.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  335.      A  BETJEF,VISCO,NECH0,NECH1)
  336.              GOTO 40
  337.         ENDIF
  338.       ENDIF
  339.       GOTO 40
  340. C
  341. C *************** COMPORTEMENT DE BICOMPRESSION **********************
  342. C
  343.    30 CONTINUE
  344. C---------------------------------------------------------------------
  345.       IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  346.         CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  347.       ENDIF
  348.       IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  349.         CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  350.       ENDIF
  351.         FCRI=SEQ-RB*AA
  352.       IF (FCRI.GT.0.D0.OR.IPLA.NE.0) THEN
  353.         CALL BEHAV2(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  354.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  355.      A  BETJEF,VISCO,NECH0,NECH1)
  356.              GOTO 40
  357.       ENDIF
  358. C---------------------------------------------------------------------
  359.    40 CONTINUE
  360. C---------------------------------------------------------------------
  361. C
  362.       IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  363.       IF(IVIS.EQ.3) THEN
  364.         CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,S2,DAM,
  365.      &  NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1)
  366.         ENDO = DAM
  367.       DO 98 I=1,NSTRS
  368.        S1(I)= S2(I)
  369.    98  CONTINUE
  370.       ENDIF
  371.       IF(IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0)) THEN
  372.        CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,SIGP,DAM,
  373.      & NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1)
  374.        ENDO = DAM
  375.        CALL VISPL1(SIGP,DSIGT,NSTRS,S2,SIGRV,DSTRN,
  376.      &    DPSTF1,DPSTF2,BETJEF,VISCO,NECH0,NECH1)
  377.        DO 99 I=1,NSTRS
  378.        S1(I)= S2(I)
  379.    99  CONTINUE
  380.       ENDIF
  381.       ENDIF
  382. C
  383. C       MODIF DEP ET CONTRAINTES
  384. C
  385.        DO 502 I=1,NSTRS
  386.        DO 121 J=1,NSTRS
  387.        D(I,J)=DEP(I,J)
  388.   121 CONTINUE
  389.   502  CONTINUE
  390. C---------------------------------------------------------------------
  391.    50 CONTINUE
  392. C---------------------------------------------------------------------
  393.       DO 42 I=1,NSTRS
  394. C        IF(ABS(S1(I)).LT.1.D-6) S1(I)=0.D0
  395.         SIGF(I)= S1(I)
  396. C        WRITE(*,*)'SIGF(',I,')=',SIGF(I)
  397.    42  CONTINUE
  398. C
  399. C
  400.    70 FORMAT (4(1X,E12.5))
  401.       RETURN
  402.       END
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  

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