Sources Esope | Cast3M

incra2
C INCRA2    SOURCE    CB215821  16/04/21    21:17:06     8920
C INCRA2    SOURCE    AC2       96/01/19    21:29:05     1995
       SUBROUTINE INCRA2(SIG,VAR,EPSVPT,VARPT,XMAT,NSTRS0,
     &                                     MFR,NVARI,NCOMAT)
      IMPLICIT INTEGER(I-N)
       IMPLICIT REAL*8(A-H,O-Z)
       REAL*8    J2SMX
       DIMENSION SIG(*),VAR(*),EPSVPT(*),VARPT(*),XMAT(*)
       DIMENSION SMOINX(6),XX(6),AN(6),ANS(6),YY(6)
       DIMENSION SIG0(6),EPS0(6),SIGX1(6),SIGX2(6)
       PARAMETER (AMAX = 1.0D20 , AMIN = 1.D-10)
       DETIER = 2.0D0/3.0D0
       ROOT = SQRT(DETIER)
C-------------------------------------------------------------------|
C
C XMAT(1)    : YOUN
C XMAT(2)    : NU
C XMAT(3)    : RHO
C XMAT(4)    : ALPH
C XMAT(5)    : ALF
C XMAT(6)    : N
C XMAT(7)    : KK
C XMAT(8)    : K0
C XMAT(9)    : ALFK
C XMAT(10)   : ALFR
C XMAT(11)   : CL1
C XMAT(12)   : DNL1
C XMAT(13)   : PHI
C XMAT(14)   : CL2
C XMAT(15)   : DNL2
C XMAT(16)   : B
C XMAT(17)   : GDM1
C XMAT(18)   : GDM2
C XMAT(19)   : PTM1
C XMAT(20)   : PTM2
C XMAT(21)   : GAMA
C XMAT(22)   : M
C XMAT(23)   : ETA
C XMAT(24)   : MU
C XMAT(25)   : QMAX
C XMAT(26)   : QSTA
C
C SIGXi      : Xi ( Xi = (2/3)  CLi  ALPHAi)
C                 ALPHAi : variable interne du type AiXX....
C
C-------------------------------------------------------------------|
C*******  CALCUL DE X1 ET X2                                        |
C-------------------------------------------------------------------I
       NSTRS = NSTRS0
       DO 12 I=1,NSTRS
         SIGX1(I) = DETIER * XMAT(11) * VAR(I)
         SIGX2(I) = DETIER * XMAT(14) * VAR(NSTRS+I)
  12   CONTINUE
C-------------------------------------------------------------------|
C*******  EVALUATION OF J2 SIGMA - X                                |
C-------------------------------------------------------------------I
       IF (MFR.EQ.5) THEN
         NSTRS=6
         SIG0(1)=SIG(1)
         SIG0(2)=SIG(2)
         SIG0(3)=0.D0
         SIG0(4)=SIG(3)
         SIG0(5)=SIG(4)
         SIG0(6)=SIG(5)
       ELSE
         NSTRS=NSTRS0
         DO 10 I=1,NSTRS
          SIG0(I)=SIG(I)
  10     CONTINUE
       ENDIF
C
       TRACE =(SIG0(1)+SIG0(2)+SIG0(3))/3.0D0
       DO 70 I=1,NSTRS
         IF (I.LE.3) THEN
           SMOINX(I) = SIG0(I) - TRACE - SIGX1(I) - SIGX2(I)
         ELSE
           SMOINX(I) = SIG0(I) - SIGX1(I) - SIGX2(I)
         ENDIF
  70   CONTINUE
       AJ2 = PROCON (SMOINX,SMOINX,NSTRS)
       J2SMX = SQRT(1.5D0*AJ2)
C--------------------------------------------------------------------|
C*******  CALCUL OF SIGV/K                                           |
C -------------------------------------------------------------------I
       RR = VAR (4*NSTRS+2)
       RS = XMAT(10)*RR
       SK = (J2SMX - RS-XMAT(7))/( XMAT(8) + XMAT(9)*RR )
C--------------------------------------------------------------------|
C*******  CALCULATION OF EFFECTIVE INELASTIC STRAIN INCREMENT (P)    |
C -------------------------------------------------------------------I
       IF (SK.GT.0.0D0) THEN
         PPT1= XPUISS(SK,XMAT(6)  ,AMAX)
         PPT2= XPUISS(SK,XMAT(6)+1.D0,AMAX)
       ELSE
         PPT1= 0.0D0
         PPT2= 0.0D0
       ENDIF
       T1  = XMAT(5)*PPT2
       PPT2=1.0D20
       IF(ABS(T1).LT.40.0D0) PPT2= EXP(T1)
       PPT = PPT1 * PPT2
       VARPT(4*NSTRS+1) = PPT
C---------------------------------------------------------------------|
C*******  CALCULATION OF INELASTIC STRAIN INCREMENTS  (EPSVPT)        |
C---------------------------------------------------------------------I
       DO 71 I=1,NSTRS,1
         IF (PPT.EQ.0.0D0) THEN
           EPS0  (I) = 0.0D0
           XX    (I) = 0.0D0
           VARPT(3*NSTRS+I)= 0.0D0
         ELSE
           XX(I)     = 1.5D0*SMOINX(I)/J2SMX
           EPS0  (I) = XX(I)*PPT
           VARPT(3*NSTRS+I)=EPS0  (I)
         ENDIF
 71    CONTINUE
C
       P      =  VAR(4*NSTRS+1)
C----------------------------------------------------------------|
C ******* CALCULATION OF PI(P)                                   |
C----------------------------------------------------------------I
       T1 = XMAT(16)*P
       T2 = EXP(-T1)
       PIP= XMAT(13)+(1.0D0-XMAT(13)) * T2
C----------------------------------------------------------------|
C*******  CALCULATION OF XII                                     |
C----------------------------------------------------------------I
       X1II =  SQRT(1.5D0*PROCON(SIGX1,SIGX1,NSTRS))
       X1IISM = 0.0D0
       IF(XMAT(17).NE.0.0D0)   X1IISM =  X1II/XMAT(17)
C
       X2II =  SQRT(1.5D0*PROCON(SIGX2,SIGX2,NSTRS))
       X2IISM = 0.0D0
       IF(XMAT(18).NE.0.0D0)   X2IISM =  X2II/XMAT(18)
C
       COX1 =  0.0D0
       COX2 =  0.0D0
       IF((X1II.GT.0.0D0).AND.(X1IISM.GT.0.0D0))
     . COX1 =  XPUISS(X1IISM,XMAT(19),AMAX) / X1II
       IF((X2II.GT.0.0D0).AND.(X2IISM.GT.0.0D0))
     . COX2 =  XPUISS(X2IISM,XMAT(20),AMAX) / X2II
C ----------------------------------------------------------------|
C*******  CALCULATION OF DX1 AND DX2                              |
C-----------------------------------------------------------------I
       DO 74 I=1,NSTRS
         T1  =  EPS0(I)
         T2  =  XMAT(12) * PIP *  VAR(I) * PPT
         T3  =  1.5D0 * COX1 * SIGX1(I)
         VARPT(I)= T1 - T2 -T3
         T2  =  XMAT(15) * PIP *  VAR(NSTRS+I) * PPT
         T3  =  1.5D0 * COX2 * SIGX2(I)
         VARPT(NSTRS+I)= T1 - T2 - T3
  74   CONTINUE
C-----------------------------------------------------------------|
C*******  CALCULATION OF DR                                       |
C-----------------------------------------------------------------I
       T1 = 1.0D0-(1.0D0-VAR(4*NSTRS+3)/XMAT(25))**2
       QR = VAR(4*NSTRS+3)-XMAT(26)*T1
       CO1= QR-VAR(4*NSTRS+2)
       CO = ABS(CO1)
       IF(CO.GT.0.0D0) CO = CO**(XMAT(22)-1.0D0)
       T1= XMAT(16)*(VAR(4*NSTRS+3)-VAR(4*NSTRS+2))*PPT
       T2= XMAT(21)*CO*CO1
       DR= T1 + T2
       VARPT(4*NSTRS+2)=DR
C----------------------------------------------------------------|
C*******  CALCULATION OF PROD (N X N*)                           |
C----------------------------------------------------------------I
       DO 75 I=1,NSTRS
         YY(I)=VAR(3*NSTRS+I) - VAR(2*NSTRS+I)
 75    CONTINUE
       AJ2=  SQRT(1.5D0*PROCON(YY,YY,NSTRS))
       IF(AJ2.LT.AMIN) THEN
         IF (AJ2.EQ.0.D0) AJ2=AMIN
         AJ20=AJ2*1.D20
         DO 15 I=1,NSTRS
         YY(I)=YY(I)*1.D20
 15      CONTINUE
       ELSE
         AJ20=AJ2
       ENDIF
       DO 76 I= 1,NSTRS
         ANS(I) = SQRT(1.5D0)*YY(I)/AJ20
         AN (I) = ROOT*XX(I)
 76    CONTINUE
       FF = DETIER*AJ2-VAR(4*NSTRS+4)
       HF=0.0D0
       IF(FF.GT.0.0D0) HF=1.0D0
       ANAN1=PROCON(AN,ANS,NSTRS)
       ANANS=0.0D0
       IF(ANAN1.GT.0.0) ANANS=ANAN1
C----------------------------------------------------------------|
C*******  CALCULATION OF DQ                                      |
C----------------------------------------------------------------I
       DQ = XMAT(23)*HF*ANANS*PPT
       VARPT(4*NSTRS+4)=DQ
C----------------------------------------------------------------|
C*******  CALCULATION OF DGETA                                   |
C----------------------------------------------------------------I
       T1  = SQRT(1.5D0)*(1.0D0-XMAT(23))*HF*ANANS*PPT
       DO 78 I=1,NSTRS
         VARPT(2*NSTRS+I)= T1*ANS(I)
  78   CONTINUE
C----------------------------------------------------------------|
C*******  CALCULATION OF DQQ                                     |
C----------------------------------------------------------------I
       VARPT(4*NSTRS+3)=2.0D0*XMAT(24)*(XMAT(25)-VAR(4*NSTRS+3))*DQ
C
       IF (MFR.EQ.5) THEN
         EPSVPT(1)=EPS0(1)
         EPSVPT(2)=EPS0(2)
         EPSVPT(3)=EPS0(4)
         EPSVPT(4)=EPS0(5)
         EPSVPT(5)=EPS0(6)
       ELSE
         DO 11 I=1,NSTRS
          EPSVPT(I)=EPS0(I)
  11     CONTINUE
       ENDIF
C
       RETURN
       END