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    PV        22/04/19    16:17:59     11344          
  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 250 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. C
  184. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  185. C           CALCUL DE LA DEFORMATION DU TIRE ELASTIQUE
  186. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  187. C
  188.        DO 260 I=1,NSTRS
  189.        DSTRN(I)=DSTRN(I)-DSTFL(I)
  190.   260  CONTINUE
  191. C
  192. C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  193. C
  194.        CALL INVMA2(H,NSTRS,ISING)
  195.        ENDIF
  196. C
  197. C ************************** CAS CONTRAINTE PLANE *********************
  198. C
  199.       IF (IFOUB.EQ.-2) THEN
  200.       IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  201.        CALL CREMAT(DH,EX,XNU,3,IFOUB)
  202.        CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS)
  203.       ELSE
  204.        CALL CREMAT(DEP,EX,XNU,3,IFOUB)
  205.       ENDIF
  206.       IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
  207.       CALL PROMA2(DEP,DSTRN,3,DSIGT)
  208.       DO 2 I=1,NSTRS
  209.          SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I)
  210.     2 CONTINUE
  211.       ENDIF
  212.       IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN
  213.       WRITE(*,*)'ATTENTION IMOD=2 ou 4 -> DEFORMATIONS PLANES'
  214.       STOP
  215.       ENDIF
  216.       ENDIF
  217. C
  218. C ***** CAS DEFORMATION PLANE ou AXISYMETRIQUE ***************
  219. C
  220.       IF (IFOUB.EQ.-1.OR.IFOUB.EQ.0) THEN
  221.       IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  222.        CALL CREMAT(DH,EX,XNU,4,IFOUB)
  223.        CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS)
  224.       ELSE
  225.        CALL CREMAT(DEP,EX,XNU,4,IFOUB)
  226.       ENDIF
  227.       CALL PROMA2(DEP,DSTRN,4,DSIGT)
  228.       DO 3 I=1,NSTRS
  229.          SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I)
  230.     3 CONTINUE
  231.       IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN
  232.       WRITE(*,*)'ATTENTION IMOD=1 ou 3 -> CONTRAINTES PLANES'
  233.       STOP
  234.       ENDIF
  235.       ENDIF
  236. C
  237. C ************************ Normalisation *********************
  238. C
  239.       DO 1 I=1,NSTRS
  240.         IF(ABS(SIGR(I)).LT.1.D-6) SIGR(I)=0.D0
  241.         IF(ABS(SIGT(I)).LT.1.D-6) SIGT(I)=0.D0
  242.     1 CONTINUE
  243. C---------------------------------------------------------------------
  244.       DO 11 I=1,NSTRS
  245.         S1(I)=SIGT(I)
  246.    11 CONTINUE
  247.       CALL PRINC(S1,V1,NSTRS)
  248. C
  249. C **************** TEST DU TYPE DE SOLLICITATION *********************
  250. C
  251.       IZON=1
  252.       IF(V1(1).LT.0.D0.AND.V1(2).LT.0.D0) IZON=0
  253.       IF(V1(1).GE.0.D0.AND.V1(2).GE.0.D0) IZON=2
  254. C---------------------------------------------------------------------
  255. C      IF (IFISU.NE.0)  GOTO 15
  256.       IF (IZON.EQ.0)  GOTO 30
  257.       IF (IZON.EQ.1.OR.IZON.EQ.2) GOTO 15
  258. C
  259. C ******************** COMPORTEMENT DE TRACTION **********************
  260. C
  261.    15 CONTINUE
  262. C           #####################################
  263. C           *        POINT DEJA FISSURE         *
  264. C           *     COMPORTEMENT   PLASTIQUE      *
  265. C           #####################################
  266. C
  267.       IF(IFISU.NE.0) THEN
  268.         IF(IZON.EQ.2) THEN
  269.         CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  270.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  271.      A  BETJEF,VISCO,NECH0,NECH1)
  272.              GOTO 40
  273.         ENDIF
  274.         IF(IZON.EQ.1) THEN
  275.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  276.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  277.      A  BETJEF,VISCO,NECH0,NECH1)
  278.              GOTO 40
  279.         ENDIF
  280.         IF(IZON.EQ.0) THEN
  281.       WRITE(*,*)'Dans elasbet un point deja fissure est teste en
  282.      *bicompression'
  283.       WRITE(*,*)'Element num:',IBB ,'au point de Gauss num:',IGAU
  284.       STOP
  285.         ENDIF
  286.       ENDIF
  287. C---------------------------------------------------------------------
  288. C           #####################################
  289. C           *     POINT  FISSURE 1ER FOIS       *
  290. C           *     COMPORTEMENT   PLASTIQUE      *
  291. C           #####################################
  292. C
  293.       Ft=ALPHA*RB
  294.       IF(V1(1).GT.Ft) THEN
  295.         IF(IZON.EQ.2) THEN
  296.         CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  297.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  298.      A  BETJEF,VISCO,NECH0,NECH1)
  299.              GOTO 40
  300.         ENDIF
  301.         IF(IZON.EQ.1) THEN
  302.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  303.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  304.      A  BETJEF,VISCO,NECH0,NECH1)
  305.              GOTO 40
  306.         ENDIF
  307.       ENDIF
  308.       IF(IZON.EQ.1.AND.IPLA.EQ.0) THEN
  309.        IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  310.         CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  311.        ENDIF
  312.        IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  313.         CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  314.        ENDIF
  315.         FCRI=SEQ-RB*AA
  316.         IF(FCRI.GT.0.D0) THEN
  317.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  318.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  319.      A  BETJEF,VISCO,NECH0,NECH1)
  320.              GOTO 40
  321.         ENDIF
  322.       ENDIF
  323.       IF(IZON.EQ.1.AND.IPLA.GE.1) THEN
  324.        IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  325.         CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  326.        ENDIF
  327.        IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  328.         CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  329.        ENDIF
  330.         FCRI=SEQ-SIG2
  331.         IF(FCRI.GT.0.D0) THEN
  332.         CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  333.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  334.      A  BETJEF,VISCO,NECH0,NECH1)
  335.              GOTO 40
  336.         ENDIF
  337.       ENDIF
  338.       GOTO 40
  339. C
  340. C *************** COMPORTEMENT DE BICOMPRESSION **********************
  341. C
  342.    30 CONTINUE
  343. C---------------------------------------------------------------------
  344.       IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN
  345.         CALL CRIVON(S1,SEQ,NSTRS,BETJEF)
  346.       ENDIF
  347.       IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN
  348.         CALL CRIDRU(S1,SEQ,NSTRS,BETJEF)
  349.       ENDIF
  350.         FCRI=SEQ-RB*AA
  351.       IF (FCRI.GT.0.D0.OR.IPLA.NE.0) THEN
  352.         CALL BEHAV2(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA,
  353.      A  SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP,
  354.      A  BETJEF,VISCO,NECH0,NECH1)
  355.              GOTO 40
  356.       ENDIF
  357. C---------------------------------------------------------------------
  358.    40 CONTINUE
  359. C---------------------------------------------------------------------
  360. C
  361.       IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN
  362.       IF(IVIS.EQ.3) THEN
  363.         CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,S2,DAM,
  364.      &  NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1)
  365.         ENDO = DAM
  366.       DO 98 I=1,NSTRS
  367.        S1(I)= S2(I)
  368.    98  CONTINUE
  369.       ENDIF
  370.       IF(IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0)) THEN
  371.        CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,SIGP,DAM,
  372.      & NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1)
  373.        ENDO = DAM
  374.        CALL VISPL1(SIGP,DSIGT,NSTRS,S2,SIGRV,DSTRN,
  375.      &    DPSTF1,DPSTF2,BETJEF,VISCO,NECH0,NECH1)
  376.        DO 99 I=1,NSTRS
  377.        S1(I)= S2(I)
  378.    99  CONTINUE
  379.       ENDIF
  380.       ENDIF
  381. C
  382. C       MODIF DEP ET CONTRAINTES
  383. C
  384.        DO 121 I=1,NSTRS
  385.        DO 121 J=1,NSTRS
  386.        D(I,J)=DEP(I,J)
  387.   121 CONTINUE
  388. C---------------------------------------------------------------------
  389.    50 CONTINUE
  390. C---------------------------------------------------------------------
  391.       DO 42 I=1,NSTRS
  392. C        IF(ABS(S1(I)).LT.1.D-6) S1(I)=0.D0
  393.         SIGF(I)= S1(I)
  394. C        WRITE(*,*)'SIGF(',I,')=',SIGF(I)
  395.    42  CONTINUE
  396. C
  397. C
  398.    70 FORMAT (4(1X,E12.5))
  399.       RETURN
  400.       END
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  

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