Télécharger la plaquette Cast3M


fr en

Télécharger incre5.eso

Retour à la liste

Numérotation des lignes : 

incre5

  1. C INCRE5    SOURCE    CB215821  16/04/21    21:17:10     8920
  2.        SUBROUTINE INCRE5(SIG,VAR,EPSVPT,VARPT,XMAT,NSTRS0,
  3.      &     MFR,NVARI,NCOMAT)
  4.       IMPLICIT INTEGER(I-N)
  5.        IMPLICIT REAL*8(A-H,O-Z)
  6.        DIMENSION SIG(*),VAR(*),EPSVPT(*),VARPT(*),XMAT(*)
  7.        DIMENSION XX(6),XT1(6),XT2(6),AN(6),ANS(6),YY(6)
  8.        DIMENSION XK1(6),XK2(6)
  9.        DIMENSION SIG0(6),EPS0(6)
  10.        PARAMETER (AMAX = 1.0D20 , AMIN = 1.D-10)
  11.        DETIER = 2.0D0/3.0D0
  12.        ROOT = SQRT(DETIER)
  13. C-------------------------------------------------------------------|
  14. C*******  EVALUATION OF J2 SIGMA - X                                |
  15. C-------------------------------------------------------------------I
  16.        IF (MFR.EQ.5) THEN
  17.          NSTRS=6
  18.          SIG0(1)=SIG(1)
  19.          SIG0(2)=SIG(2)
  20.          SIG0(3)=0.D0
  21.          SIG0(4)=SIG(3)
  22.          SIG0(5)=SIG(4)
  23.          SIG0(6)=SIG(5)
  24.        ELSE
  25.          NSTRS=NSTRS0
  26.          DO 10 I=1,NSTRS
  27.           SIG0(I)=SIG(I)
  28.   10     CONTINUE
  29.        ENDIF
  30.        TRACE =(SIG0(1)+SIG0(2)+SIG0(3))/3.0D0
  31.        DO 70 I=1,NSTRS
  32.        A = 0.0D0
  33.        IF (I.LE.3) A=1.0D0
  34.        XX(I) = SIG0(I)-A*TRACE - VAR(I)-VAR(NSTRS+I)
  35.   70   CONTINUE
  36.        AJ2 = PROCON (XX,XX,NSTRS)
  37.        AJ2 = SQRT(1.5D0*AJ2)
  38. C--------------------------------------------------------------------|
  39. C*******  CALCUL OF SIGV/K                                           |
  40. C -------------------------------------------------------------------I
  41.        RR = VAR (4*NSTRS+2)
  42.        RS = XMAT(10)*RR
  43.        SK = (AJ2 - RS-XMAT(7))/( XMAT(8) + XMAT(9)*RR )
  44. C--------------------------------------------------------------------|
  45. C*******  CALCULATION OF EFFECTIVE INELASTIC STRAIN INCREMENT (P)    |
  46. C -------------------------------------------------------------------I
  47.        IF (SK.GT.0.0D0) THEN
  48.        PPT1= XPUISS(SK,XMAT(6)  ,AMAX)
  49.        PPT2= XPUISS(SK,XMAT(6)+1.D0,AMAX)
  50.        ELSE
  51.        PPT1= 0.0D0
  52.        PPT2= 0.0D0
  53.        ENDIF
  54.        T1  = XMAT(5)*PPT2
  55.        PPT2=1.0D20
  56.        IF(ABS(T1).LT.40.0D0) PPT2= EXP(T1)
  57.        PPT = PPT1 * PPT2
  58.        VARPT(4*NSTRS+1) = PPT
  59. C---------------------------------------------------------------------|
  60. C*******  CALCULATION OF INELASTIC STRAIN INCREMENTS  (EPS0)          |
  61. C---------------------------------------------------------------------I
  62.        DO 71 I=1,NSTRS,1
  63.        IF (PPT.EQ.0.0) THEN
  64.        EPS0  (I) = 0.0D0
  65.        XX    (I) = 0.0D0
  66.        VARPT(3*NSTRS+I)= 0.0D0
  67.        ELSE
  68.        XX(I)     = 1.5D0*XX(I)/AJ2
  69.        EPS0  (I) = XX(I)*PPT
  70.        VARPT(3*NSTRS+I)=EPS0(I)
  71.        ENDIF
  72.  71    CONTINUE
  73. C
  74.        P      =  VAR(4*NSTRS+1)
  75. C----------------------------------------------------------------|
  76. C ******* CALCULATION OF PI(P)                                   |
  77. C----------------------------------------------------------------I
  78.        T1 = XMAT(16)*P
  79.        T2 = EXP(-T1)
  80.        PIP= XMAT(13)+(1.0D0-XMAT(13)) * T2
  81. C----------------------------------------------------------------|
  82. C*******  CALCULATION OF XII                                     |
  83. C----------------------------------------------------------------I
  84.        DO 72 I=1,NSTRS
  85.        XT1(I)=VAR(I)
  86.        XT2(I)=VAR(I+NSTRS)
  87.   72   CONTINUE
  88.        X1II =  0.0D0
  89.        X2II =  0.0D0
  90.        IF(XMAT(17).NE.0.0D0)
  91.      . X1II =  SQRT(1.5D0*PROCON(XT1,XT1,NSTRS))/XMAT(17)
  92.        IF(XMAT(18).NE.0.0D0)
  93.      . X2II =  SQRT(1.5D0*PROCON(XT2,XT2,NSTRS))/XMAT(18)
  94.        COX1 =  0.0D0
  95.        COX2 =  0.0D0
  96.        IF(X1II.GT.0.0D0) then
  97.          clox1=(xmat(19)-1.D0)*log(X1II)
  98.          clox1=min(max(-300d0,clox1),300d0)
  99.          COX1 =  exp(clox1)
  100.        endif
  101.        IF(X2II.GT.0.0D0) then
  102.          clox2=(xmat(20)-1.D0)*log(X2II)
  103.          clox2=min(max(-300d0,clox2),300d0)
  104.          COX2 =  exp(clox2)
  105.        endif
  106. **     IF(X2II.GT.0.0D0) COX2 =  X2II**(XMAT(20)-1.0D0)
  107. C-----------------------------------------------------------------|
  108. C*******  CALCULATION OF ( (X/r)**EXP ) * < DEPST : k >           |
  109. C-----------------------------------------------------------------|
  110.        X1II=SQRT(1.5D0*PROCON(XT1,XT1,NSTRS))
  111.        X2II=SQRT(1.5D0*PROCON(XT2,XT2,NSTRS))
  112.        IF (X1II.NE.0.D0) THEN
  113.         DO 720 I=1,NSTRS
  114.           XK1(I)=XT1(I)/X1II
  115.  720    CONTINUE
  116.        ELSE
  117.         DO 721 I=1,NSTRS
  118.           XK1(I)=0.D0
  119.  721    CONTINUE
  120.        ENDIF
  121.        IF (X2II.NE.0.D0) THEN
  122.         DO 722 I=1,NSTRS
  123.           XK2(I)=XT2(I)/X2II
  124.  722    CONTINUE
  125.        ELSE
  126.         DO 723 I=1,NSTRS
  127.           XK2(I)=0.D0
  128.  723    CONTINUE
  129.        ENDIF
  130.        PROD1=PROCON(EPS0,XK1,NSTRS)
  131.        PROD2=PROCON(EPS0,XK2,NSTRS)
  132.        IF (PROD1.LT.0.D0) PROD1=0.D0
  133.        IF (PROD2.LT.0.D0) PROD2=0.D0
  134.        XLIM1=XMAT(12)/PIP
  135.        XLIM2=XMAT(15)/PIP
  136.        RAPP1=(X1II/XLIM1)**XMAT(27)
  137.        RAPP2=(X2II/XLIM2)**XMAT(28)
  138.        PPT10=RAPP1*PROD1
  139.        PPT20=RAPP2*PROD2
  140. C ----------------------------------------------------------------|
  141. C*******  CALCULATION OF DX1 AND DX2                              |
  142. C-----------------------------------------------------------------I
  143.        DO 73 I=1,NSTRS
  144.        VARPT(      I)=0.0D0
  145.   73   VARPT(NSTRS+I)=0.0D0
  146.        DO 74 I=1,NSTRS
  147.        T1  =  DETIER  * XMAT(11) * XMAT(12) *  EPS0(I)
  148.        T2  =  XMAT(11) * PIP *  XT1(I) * PPT10
  149.        T3  =  COX1 *  XT1(I)
  150.        VARPT(I)= T1 - T2 -T3
  151.        T1  =  DETIER * XMAT(14) * XMAT(15) *  EPS0(I)
  152.        T2  =  XMAT(14) * PIP *  XT2(I) * PPT20
  153.        T3  =  COX2 *  XT2(I)
  154.   74   VARPT(NSTRS+I)= T1 - T2 - T3
  155. C-----------------------------------------------------------------|
  156. C*******  CALCULATION OF DR                                       |
  157. C-----------------------------------------------------------------I
  158.        T1 = 1.0D0-(1.0D0-VAR(4*NSTRS+3)/XMAT(25))**2
  159.        QR = VAR(4*NSTRS+3)-XMAT(26)*T1
  160.        CO1= QR-VAR(4*NSTRS+2)
  161.        CO = ABS(CO1)
  162.        IF(CO.GT.0.0D0) CO = CO**(XMAT(22)-1.0D0)
  163.        T1= XMAT(16)*(VAR(4*NSTRS+3)-VAR(4*NSTRS+2))*PPT
  164.        T2= XMAT(21)*CO*CO1
  165.        DR= T1 + T2
  166.        VARPT(4*NSTRS+2)=DR
  167. C----------------------------------------------------------------|
  168. C*******  CALCULATION OF PROD (N X N*)                           |
  169. C----------------------------------------------------------------I
  170.        DO 75 I=1,NSTRS
  171. *       A=1.0D0
  172. *       IF(I.GT.3) A = 2.0D0
  173.        YY(I)=VAR(3*NSTRS+I) - VAR(2*NSTRS+I)
  174.  75    CONTINUE
  175.        AJ2=  SQRT(1.5D0*PROCON(YY,YY,NSTRS))
  176.        IF(AJ2.LT.AMIN) AJ2=AMIN
  177.        DO 76 I= 1,NSTRS
  178.        ANS(I) = SQRT(1.5D0)*YY(I)/AJ2
  179.        AN (I) = ROOT*XX(I)
  180.  76    CONTINUE
  181.        FF = DETIER*AJ2-VAR(4*NSTRS+4)
  182.        HF=0.0D0
  183.        IF(FF.GT.0.0D0) HF=1.0D0
  184.        ANAN1=PROCON(AN,ANS,NSTRS)
  185.        ANANS=0.0D0
  186.        IF(ANAN1.GT.0.0) ANANS=ANAN1
  187. C----------------------------------------------------------------|
  188. C*******  CALCULATION OF DQ                                      |
  189. C----------------------------------------------------------------I
  190.        DQ = XMAT(23)*HF*ANANS*PPT
  191.        VARPT(4*NSTRS+4)=DQ
  192. C----------------------------------------------------------------|
  193. C*******  CALCULATION OF DGETA                                   |
  194. C----------------------------------------------------------------I
  195.        T1  = SQRT(1.5D0)*(1.0D0-XMAT(23))*HF*ANANS*PPT
  196.        DO 78 I=1,NSTRS
  197.        VARPT(2*NSTRS+I)= T1*ANS(I)
  198.   78   CONTINUE
  199. C----------------------------------------------------------------|
  200. C*******  CALCULATION OF DQQ                                     |
  201. C----------------------------------------------------------------I
  202.        VARPT(4*NSTRS+3)=2.0D0*XMAT(24)*(XMAT(25)-VAR(4*NSTRS+3))*DQ
  203. C
  204. C
  205.        IF (MFR.EQ.5) THEN
  206.          EPSVPT(1)=EPS0(1)
  207.          EPSVPT(2)=EPS0(2)
  208.          EPSVPT(3)=EPS0(4)
  209.          EPSVPT(4)=EPS0(5)
  210.          EPSVPT(5)=EPS0(6)
  211.        ELSE
  212.          DO 11 I=1,NSTRS
  213.           EPSVPT(I)=EPS0(I)
  214.   11     CONTINUE
  215.        ENDIF
  216. C
  217.        RETURN
  218.        END
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  

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