1 : C INCRE5 SOURCE CHAT 05/01/13 00:35:23 5004 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(DABS(T1).LT.40.0D0) PPT2= DEXP(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 = DEXP(-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) COX1 = X1II**(XMAT(19)-1.0D0) 97 : IF(X2II.GT.0.0D0) COX2 = X2II**(XMAT(20)-1.0D0) 98 : C-----------------------------------------------------------------| 99 : C******* CALCULATION OF ( (X/r)**EXP ) * < DEPST : k > | 100 : C-----------------------------------------------------------------| 101 : X1II=SQRT(1.5D0*PROCON(XT1,XT1,NSTRS)) 102 : X2II=SQRT(1.5D0*PROCON(XT2,XT2,NSTRS)) 103 : IF (X1II.NE.0.D0) THEN 104 : DO 720 I=1,NSTRS 105 : XK1(I)=XT1(I)/X1II 106 : 720 CONTINUE 107 : ELSE 108 : DO 721 I=1,NSTRS 109 : XK1(I)=0.D0 110 : 721 CONTINUE 111 : ENDIF 112 : IF (X2II.NE.0.D0) THEN 113 : DO 722 I=1,NSTRS 114 : XK2(I)=XT2(I)/X2II 115 : 722 CONTINUE 116 : ELSE 117 : DO 723 I=1,NSTRS 118 : XK2(I)=0.D0 119 : 723 CONTINUE 120 : ENDIF 121 : PROD1=PROCON(EPS0,XK1,NSTRS) 122 : PROD2=PROCON(EPS0,XK2,NSTRS) 123 : IF (PROD1.LT.0.D0) PROD1=0.D0 124 : IF (PROD2.LT.0.D0) PROD2=0.D0 125 : XLIM1=XMAT(12)/PIP 126 : XLIM2=XMAT(15)/PIP 127 : RAPP1=(X1II/XLIM1)**XMAT(27) 128 : RAPP2=(X2II/XLIM2)**XMAT(28) 129 : PPT10=RAPP1*PROD1 130 : PPT20=RAPP2*PROD2 131 : C ----------------------------------------------------------------| 132 : C******* CALCULATION OF DX1 AND DX2 | 133 : C-----------------------------------------------------------------I 134 : DO 73 I=1,NSTRS 135 : VARPT( I)=0.0D0 136 : 73 VARPT(NSTRS+I)=0.0D0 137 : DO 74 I=1,NSTRS 138 : T1 = DETIER * XMAT(11) * XMAT(12) * EPS0(I) 139 : T2 = XMAT(11) * PIP * XT1(I) * PPT10 140 : T3 = COX1 * XT1(I) 141 : VARPT(I)= T1 - T2 -T3 142 : T1 = DETIER * XMAT(14) * XMAT(15) * EPS0(I) 143 : T2 = XMAT(14) * PIP * XT2(I) * PPT20 144 : T3 = COX2 * XT2(I) 145 : 74 VARPT(NSTRS+I)= T1 - T2 - T3 146 : C-----------------------------------------------------------------| 147 : C******* CALCULATION OF DR | 148 : C-----------------------------------------------------------------I 149 : T1 = 1.0D0-(1.0D0-VAR(4*NSTRS+3)/XMAT(25))**2 150 : QR = VAR(4*NSTRS+3)-XMAT(26)*T1 151 : CO1= QR-VAR(4*NSTRS+2) 152 : CO = DABS(CO1) 153 : IF(CO.GT.0.0D0) CO = CO**(XMAT(22)-1.0D0) 154 : T1= XMAT(16)*(VAR(4*NSTRS+3)-VAR(4*NSTRS+2))*PPT 155 : T2= XMAT(21)*CO*CO1 156 : DR= T1 + T2 157 : VARPT(4*NSTRS+2)=DR 158 : C----------------------------------------------------------------| 159 : C******* CALCULATION OF PROD (N X N*) | 160 : C----------------------------------------------------------------I 161 : DO 75 I=1,NSTRS 162 : * A=1.0D0 163 : * IF(I.GT.3) A = 2.0D0 164 : YY(I)=VAR(3*NSTRS+I) - VAR(2*NSTRS+I) 165 : 75 CONTINUE 166 : AJ2= SQRT(1.5D0*PROCON(YY,YY,NSTRS)) 167 : IF(AJ2.LT.AMIN) AJ2=AMIN 168 : DO 76 I= 1,NSTRS 169 : ANS(I) = SQRT(1.5D0)*YY(I)/AJ2 170 : AN (I) = ROOT*XX(I) 171 : 76 CONTINUE 172 : FF = DETIER*AJ2-VAR(4*NSTRS+4) 173 : HF=0.0D0 174 : IF(FF.GT.0.0D0) HF=1.0D0 175 : ANAN1=PROCON(AN,ANS,NSTRS) 176 : ANANS=0.0D0 177 : IF(ANAN1.GT.0.0) ANANS=ANAN1 178 : C----------------------------------------------------------------| 179 : C******* CALCULATION OF DQ | 180 : C----------------------------------------------------------------I 181 : DQ = XMAT(23)*HF*ANANS*PPT 182 : VARPT(4*NSTRS+4)=DQ 183 : C----------------------------------------------------------------| 184 : C******* CALCULATION OF DGETA | 185 : C----------------------------------------------------------------I 186 : T1 = SQRT(1.5D0)*(1.0D0-XMAT(23))*HF*ANANS*PPT 187 : DO 78 I=1,NSTRS 188 : VARPT(2*NSTRS+I)= T1*ANS(I) 189 : 78 CONTINUE 190 : C----------------------------------------------------------------| 191 : C******* CALCULATION OF DQQ | 192 : C----------------------------------------------------------------I 193 : VARPT(4*NSTRS+3)=2.0D0*XMAT(24)*(XMAT(25)-VAR(4*NSTRS+3))*DQ 194 : C 195 : C 196 : IF (MFR.EQ.5) THEN 197 : EPSVPT(1)=EPS0(1) 198 : EPSVPT(2)=EPS0(2) 199 : EPSVPT(3)=EPS0(4) 200 : EPSVPT(4)=EPS0(5) 201 : EPSVPT(5)=EPS0(6) 202 : ELSE 203 : DO 11 I=1,NSTRS 204 : EPSVPT(I)=EPS0(I) 205 : 11 CONTINUE 206 : ENDIF 207 : C 208 : RETURN 209 : END 210 : 211 : 212 : 213 :
© Cast3M 2003 - All rights reserved.
Disclaimer