1 : C INCRE2 SOURCE CHAT 05/01/13 00:35:13 5004 2 : SUBROUTINE INCRE2(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 SIG0(6),EPS0(6) 9 : PARAMETER (AMAX = 1.0D20 , AMIN = 1.D-10) 10 : DETIER = 2.0D0/3.0D0 11 : ROOT = SQRT(DETIER) 12 : C-------------------------------------------------------------------| 13 : C******* EVALUATION OF J2 SIGMA - X | 14 : C-------------------------------------------------------------------I 15 : IF (MFR.EQ.5) THEN 16 : NSTRS=6 17 : SIG0(1)=SIG(1) 18 : SIG0(2)=SIG(2) 19 : SIG0(3)=0.D0 20 : SIG0(4)=SIG(3) 21 : SIG0(5)=SIG(4) 22 : SIG0(6)=SIG(5) 23 : ELSE 24 : NSTRS=NSTRS0 25 : DO 10 I=1,NSTRS 26 : SIG0(I)=SIG(I) 27 : 10 CONTINUE 28 : ENDIF 29 : TRACE =(SIG0(1)+SIG0(2)+SIG0(3))/3.0D0 30 : DO 70 I=1,NSTRS 31 : A = 0.0D0 32 : IF (I.LE.3) A=1.0D0 33 : XX(I) = SIG0(I)-A*TRACE - VAR(I)-VAR(NSTRS+I) 34 : 70 CONTINUE 35 : AJ2 = PROCON (XX,XX,NSTRS) 36 : AJ2 = SQRT(1.5D0*AJ2) 37 : C--------------------------------------------------------------------| 38 : C******* CALCUL OF SIGV/K | 39 : C -------------------------------------------------------------------I 40 : RR = VAR (4*NSTRS+2) 41 : RS = XMAT(10)*RR 42 : SK = (AJ2 - RS-XMAT(7))/( XMAT(8) + XMAT(9)*RR ) 43 : C--------------------------------------------------------------------| 44 : C******* CALCULATION OF EFFECTIVE INELASTIC STRAIN INCREMENT (P) | 45 : C -------------------------------------------------------------------I 46 : IF (SK.GT.0.0D0) THEN 47 : PPT1= XPUISS(SK,XMAT(6) ,AMAX) 48 : PPT2= XPUISS(SK,XMAT(6)+1.D0,AMAX) 49 : ELSE 50 : PPT1= 0.0D0 51 : PPT2= 0.0D0 52 : ENDIF 53 : T1 = XMAT(5)*PPT2 54 : PPT2=1.0D20 55 : IF(DABS(T1).LT.40.0D0) PPT2= DEXP(T1) 56 : PPT = PPT1 * PPT2 57 : VARPT(4*NSTRS+1) = PPT 58 : C---------------------------------------------------------------------| 59 : C******* CALCULATION OF INELASTIC STRAIN INCREMENTS (EPSVPT) | 60 : C---------------------------------------------------------------------I 61 : DO 71 I=1,NSTRS,1 62 : IF (PPT.EQ.0.0) THEN 63 : EPS0 (I) = 0.0D0 64 : XX (I) = 0.0D0 65 : VARPT(3*NSTRS+I)= 0.0D0 66 : ELSE 67 : XX(I) = 1.5D0*XX(I)/AJ2 68 : EPS0 (I) = XX(I)*PPT 69 : VARPT(3*NSTRS+I)=EPS0 (I) 70 : ENDIF 71 : 71 CONTINUE 72 : C 73 : P = VAR(4*NSTRS+1) 74 : C----------------------------------------------------------------| 75 : C ******* CALCULATION OF PI(P) | 76 : C----------------------------------------------------------------I 77 : T1 = XMAT(16)*P 78 : T2 = DEXP(-T1) 79 : PIP= XMAT(13)+(1.0D0-XMAT(13)) * T2 80 : C----------------------------------------------------------------| 81 : C******* CALCULATION OF XII | 82 : C----------------------------------------------------------------I 83 : DO 72 I=1,NSTRS 84 : XT1(I)=VAR(I) 85 : XT2(I)=VAR(I+NSTRS) 86 : 72 CONTINUE 87 : X1II = 0.0D0 88 : X2II = 0.0D0 89 : IF(XMAT(17).NE.0.0D0) 90 : . X1II = SQRT(1.5D0*PROCON(XT1,XT1,NSTRS))/XMAT(17) 91 : IF(XMAT(18).NE.0.0D0) 92 : . X2II = SQRT(1.5D0*PROCON(XT2,XT2,NSTRS))/XMAT(18) 93 : COX1 = 0.0D0 94 : COX2 = 0.0D0 95 : IF(X1II.GT.0.0D0) COX1 = X1II**(XMAT(19)-1.0D0) 96 : IF(X2II.GT.0.0D0) COX2 = X2II**(XMAT(20)-1.0D0) 97 : C ----------------------------------------------------------------| 98 : C******* CALCULATION OF DX1 AND DX2 | 99 : C-----------------------------------------------------------------I 100 : DO 73 I=1,NSTRS 101 : VARPT( I)=0.0D0 102 : 73 VARPT(NSTRS+I)=0.0D0 103 : DO 74 I=1,NSTRS 104 : T1 = DETIER * XMAT(11) * XMAT(12) * EPS0(I) 105 : T2 = XMAT(11) * PIP * XT1(I) * PPT 106 : T3 = COX1 * XT1(I) 107 : VARPT(I)= T1 - T2 -T3 108 : T1 = DETIER * XMAT(14) * XMAT(15) * EPS0(I) 109 : T2 = XMAT(14) * PIP * XT2(I) * PPT 110 : T3 = COX2 * XT2(I) 111 : 74 VARPT(NSTRS+I)= T1 - T2 - T3 112 : C-----------------------------------------------------------------| 113 : C******* CALCULATION OF DR | 114 : C-----------------------------------------------------------------I 115 : T1 = 1.0D0-(1.0D0-VAR(4*NSTRS+3)/XMAT(25))**2 116 : QR = VAR(4*NSTRS+3)-XMAT(26)*T1 117 : CO1= QR-VAR(4*NSTRS+2) 118 : CO = DABS(CO1) 119 : IF(CO.GT.0.0D0) CO = CO**(XMAT(22)-1.0D0) 120 : T1= XMAT(16)*(VAR(4*NSTRS+3)-VAR(4*NSTRS+2))*PPT 121 : T2= XMAT(21)*CO*CO1 122 : DR= T1 + T2 123 : VARPT(4*NSTRS+2)=DR 124 : C----------------------------------------------------------------| 125 : C******* CALCULATION OF PROD (N X N*) | 126 : C----------------------------------------------------------------I 127 : DO 75 I=1,NSTRS 128 : * A=1.0D0 129 : * IF(I.GT.3) A = 2.0D0 130 : YY(I)=VAR(3*NSTRS+I) - VAR(2*NSTRS+I) 131 : 75 CONTINUE 132 : AJ2= SQRT(1.5D0*PROCON(YY,YY,NSTRS)) 133 : IF(AJ2.LT.AMIN) THEN 134 : IF (AJ2.EQ.0.D0) AJ2=AMIN 135 : AJ20=AJ2*1.D20 136 : DO 15 I=1,NSTRS 137 : YY(I)=YY(I)*1.D20 138 : 15 CONTINUE 139 : ELSE 140 : AJ20=AJ2 141 : ENDIF 142 : * IF (AJ2.LT.AMIN) AJ20=AMIN 143 : DO 76 I= 1,NSTRS 144 : ANS(I) = SQRT(1.5D0)*YY(I)/AJ20 145 : AN (I) = ROOT*XX(I) 146 : 76 CONTINUE 147 : FF = DETIER*AJ2-VAR(4*NSTRS+4) 148 : HF=0.0D0 149 : IF(FF.GT.0.0D0) HF=1.0D0 150 : ANAN1=PROCON(AN,ANS,NSTRS) 151 : ANANS=0.0D0 152 : IF(ANAN1.GT.0.0) ANANS=ANAN1 153 : C----------------------------------------------------------------| 154 : C******* CALCULATION OF DQ | 155 : C----------------------------------------------------------------I 156 : DQ = XMAT(23)*HF*ANANS*PPT 157 : VARPT(4*NSTRS+4)=DQ 158 : C----------------------------------------------------------------| 159 : C******* CALCULATION OF DGETA | 160 : C----------------------------------------------------------------I 161 : T1 = SQRT(1.5D0)*(1.0D0-XMAT(23))*HF*ANANS*PPT 162 : DO 78 I=1,NSTRS 163 : VARPT(2*NSTRS+I)= T1*ANS(I) 164 : 78 CONTINUE 165 : C----------------------------------------------------------------| 166 : C******* CALCULATION OF DQQ | 167 : C----------------------------------------------------------------I 168 : VARPT(4*NSTRS+3)=2.0D0*XMAT(24)*(XMAT(25)-VAR(4*NSTRS+3))*DQ 169 : C 170 : IF (MFR.EQ.5) THEN 171 : EPSVPT(1)=EPS0(1) 172 : EPSVPT(2)=EPS0(2) 173 : EPSVPT(3)=EPS0(4) 174 : EPSVPT(4)=EPS0(5) 175 : EPSVPT(5)=EPS0(6) 176 : ELSE 177 : DO 11 I=1,NSTRS 178 : EPSVPT(I)=EPS0(I) 179 : 11 CONTINUE 180 : ENDIF 181 : C 182 : RETURN 183 : END 184 : 185 : 186 :
© Cast3M 2003 - All rights reserved.
Disclaimer