C INCRA2 SOURCE CHAT 05/01/13 00:34:55 5004 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(DABS(T1).LT.40.0D0) PPT2= DEXP(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 = DEXP(-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 = DABS(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