1 : C INCRA2 SOURCE CHAT 05/01/13 00:34:55 5004 2 : C INCRA2 SOURCE AC2 96/01/19 21:29:05 1995 3 : SUBROUTINE INCRA2(SIG,VAR,EPSVPT,VARPT,XMAT,NSTRS0, 4 : & MFR,NVARI,NCOMAT) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : REAL*8 J2SMX 8 : DIMENSION SIG(*),VAR(*),EPSVPT(*),VARPT(*),XMAT(*) 9 : DIMENSION SMOINX(6),XX(6),AN(6),ANS(6),YY(6) 10 : DIMENSION SIG0(6),EPS0(6),SIGX1(6),SIGX2(6) 11 : PARAMETER (AMAX = 1.0D20 , AMIN = 1.D-10) 12 : DETIER = 2.0D0/3.0D0 13 : ROOT = SQRT(DETIER) 14 : C-------------------------------------------------------------------| 15 : C 16 : C XMAT(1) : YOUN 17 : C XMAT(2) : NU 18 : C XMAT(3) : RHO 19 : C XMAT(4) : ALPH 20 : C XMAT(5) : ALF 21 : C XMAT(6) : N 22 : C XMAT(7) : KK 23 : C XMAT(8) : K0 24 : C XMAT(9) : ALFK 25 : C XMAT(10) : ALFR 26 : C XMAT(11) : CL1 27 : C XMAT(12) : DNL1 28 : C XMAT(13) : PHI 29 : C XMAT(14) : CL2 30 : C XMAT(15) : DNL2 31 : C XMAT(16) : B 32 : C XMAT(17) : GDM1 33 : C XMAT(18) : GDM2 34 : C XMAT(19) : PTM1 35 : C XMAT(20) : PTM2 36 : C XMAT(21) : GAMA 37 : C XMAT(22) : M 38 : C XMAT(23) : ETA 39 : C XMAT(24) : MU 40 : C XMAT(25) : QMAX 41 : C XMAT(26) : QSTA 42 : C 43 : C SIGXi : Xi ( Xi = (2/3) CLi ALPHAi) 44 : C ALPHAi : variable interne du type AiXX.... 45 : C 46 : C-------------------------------------------------------------------| 47 : C******* CALCUL DE X1 ET X2 | 48 : C-------------------------------------------------------------------I 49 : NSTRS = NSTRS0 50 : DO 12 I=1,NSTRS 51 : SIGX1(I) = DETIER * XMAT(11) * VAR(I) 52 : SIGX2(I) = DETIER * XMAT(14) * VAR(NSTRS+I) 53 : 12 CONTINUE 54 : C-------------------------------------------------------------------| 55 : C******* EVALUATION OF J2 SIGMA - X | 56 : C-------------------------------------------------------------------I 57 : IF (MFR.EQ.5) THEN 58 : NSTRS=6 59 : SIG0(1)=SIG(1) 60 : SIG0(2)=SIG(2) 61 : SIG0(3)=0.D0 62 : SIG0(4)=SIG(3) 63 : SIG0(5)=SIG(4) 64 : SIG0(6)=SIG(5) 65 : ELSE 66 : NSTRS=NSTRS0 67 : DO 10 I=1,NSTRS 68 : SIG0(I)=SIG(I) 69 : 10 CONTINUE 70 : ENDIF 71 : C 72 : TRACE =(SIG0(1)+SIG0(2)+SIG0(3))/3.0D0 73 : DO 70 I=1,NSTRS 74 : IF (I.LE.3) THEN 75 : SMOINX(I) = SIG0(I) - TRACE - SIGX1(I) - SIGX2(I) 76 : ELSE 77 : SMOINX(I) = SIG0(I) - SIGX1(I) - SIGX2(I) 78 : ENDIF 79 : 70 CONTINUE 80 : AJ2 = PROCON (SMOINX,SMOINX,NSTRS) 81 : J2SMX = SQRT(1.5D0*AJ2) 82 : C--------------------------------------------------------------------| 83 : C******* CALCUL OF SIGV/K | 84 : C -------------------------------------------------------------------I 85 : RR = VAR (4*NSTRS+2) 86 : RS = XMAT(10)*RR 87 : SK = (J2SMX - RS-XMAT(7))/( XMAT(8) + XMAT(9)*RR ) 88 : C--------------------------------------------------------------------| 89 : C******* CALCULATION OF EFFECTIVE INELASTIC STRAIN INCREMENT (P) | 90 : C -------------------------------------------------------------------I 91 : IF (SK.GT.0.0D0) THEN 92 : PPT1= XPUISS(SK,XMAT(6) ,AMAX) 93 : PPT2= XPUISS(SK,XMAT(6)+1.D0,AMAX) 94 : ELSE 95 : PPT1= 0.0D0 96 : PPT2= 0.0D0 97 : ENDIF 98 : T1 = XMAT(5)*PPT2 99 : PPT2=1.0D20 100 : IF(DABS(T1).LT.40.0D0) PPT2= DEXP(T1) 101 : PPT = PPT1 * PPT2 102 : VARPT(4*NSTRS+1) = PPT 103 : C---------------------------------------------------------------------| 104 : C******* CALCULATION OF INELASTIC STRAIN INCREMENTS (EPSVPT) | 105 : C---------------------------------------------------------------------I 106 : DO 71 I=1,NSTRS,1 107 : IF (PPT.EQ.0.0D0) THEN 108 : EPS0 (I) = 0.0D0 109 : XX (I) = 0.0D0 110 : VARPT(3*NSTRS+I)= 0.0D0 111 : ELSE 112 : XX(I) = 1.5D0*SMOINX(I)/J2SMX 113 : EPS0 (I) = XX(I)*PPT 114 : VARPT(3*NSTRS+I)=EPS0 (I) 115 : ENDIF 116 : 71 CONTINUE 117 : C 118 : P = VAR(4*NSTRS+1) 119 : C----------------------------------------------------------------| 120 : C ******* CALCULATION OF PI(P) | 121 : C----------------------------------------------------------------I 122 : T1 = XMAT(16)*P 123 : T2 = DEXP(-T1) 124 : PIP= XMAT(13)+(1.0D0-XMAT(13)) * T2 125 : C----------------------------------------------------------------| 126 : C******* CALCULATION OF XII | 127 : C----------------------------------------------------------------I 128 : X1II = SQRT(1.5D0*PROCON(SIGX1,SIGX1,NSTRS)) 129 : X1IISM = 0.0D0 130 : IF(XMAT(17).NE.0.0D0) X1IISM = X1II/XMAT(17) 131 : C 132 : X2II = SQRT(1.5D0*PROCON(SIGX2,SIGX2,NSTRS)) 133 : X2IISM = 0.0D0 134 : IF(XMAT(18).NE.0.0D0) X2IISM = X2II/XMAT(18) 135 : C 136 : COX1 = 0.0D0 137 : COX2 = 0.0D0 138 : IF((X1II.GT.0.0D0).AND.(X1IISM.GT.0.0D0)) 139 : . COX1 = XPUISS(X1IISM,XMAT(19),AMAX) / X1II 140 : IF((X2II.GT.0.0D0).AND.(X2IISM.GT.0.0D0)) 141 : . COX2 = XPUISS(X2IISM,XMAT(20),AMAX) / X2II 142 : C ----------------------------------------------------------------| 143 : C******* CALCULATION OF DX1 AND DX2 | 144 : C-----------------------------------------------------------------I 145 : DO 74 I=1,NSTRS 146 : T1 = EPS0(I) 147 : T2 = XMAT(12) * PIP * VAR(I) * PPT 148 : T3 = 1.5D0 * COX1 * SIGX1(I) 149 : VARPT(I)= T1 - T2 -T3 150 : T2 = XMAT(15) * PIP * VAR(NSTRS+I) * PPT 151 : T3 = 1.5D0 * COX2 * SIGX2(I) 152 : VARPT(NSTRS+I)= T1 - T2 - T3 153 : 74 CONTINUE 154 : C-----------------------------------------------------------------| 155 : C******* CALCULATION OF DR | 156 : C-----------------------------------------------------------------I 157 : T1 = 1.0D0-(1.0D0-VAR(4*NSTRS+3)/XMAT(25))**2 158 : QR = VAR(4*NSTRS+3)-XMAT(26)*T1 159 : CO1= QR-VAR(4*NSTRS+2) 160 : CO = DABS(CO1) 161 : IF(CO.GT.0.0D0) CO = CO**(XMAT(22)-1.0D0) 162 : T1= XMAT(16)*(VAR(4*NSTRS+3)-VAR(4*NSTRS+2))*PPT 163 : T2= XMAT(21)*CO*CO1 164 : DR= T1 + T2 165 : VARPT(4*NSTRS+2)=DR 166 : C----------------------------------------------------------------| 167 : C******* CALCULATION OF PROD (N X N*) | 168 : C----------------------------------------------------------------I 169 : DO 75 I=1,NSTRS 170 : YY(I)=VAR(3*NSTRS+I) - VAR(2*NSTRS+I) 171 : 75 CONTINUE 172 : AJ2= SQRT(1.5D0*PROCON(YY,YY,NSTRS)) 173 : IF(AJ2.LT.AMIN) THEN 174 : IF (AJ2.EQ.0.D0) AJ2=AMIN 175 : AJ20=AJ2*1.D20 176 : DO 15 I=1,NSTRS 177 : YY(I)=YY(I)*1.D20 178 : 15 CONTINUE 179 : ELSE 180 : AJ20=AJ2 181 : ENDIF 182 : DO 76 I= 1,NSTRS 183 : ANS(I) = SQRT(1.5D0)*YY(I)/AJ20 184 : AN (I) = ROOT*XX(I) 185 : 76 CONTINUE 186 : FF = DETIER*AJ2-VAR(4*NSTRS+4) 187 : HF=0.0D0 188 : IF(FF.GT.0.0D0) HF=1.0D0 189 : ANAN1=PROCON(AN,ANS,NSTRS) 190 : ANANS=0.0D0 191 : IF(ANAN1.GT.0.0) ANANS=ANAN1 192 : C----------------------------------------------------------------| 193 : C******* CALCULATION OF DQ | 194 : C----------------------------------------------------------------I 195 : DQ = XMAT(23)*HF*ANANS*PPT 196 : VARPT(4*NSTRS+4)=DQ 197 : C----------------------------------------------------------------| 198 : C******* CALCULATION OF DGETA | 199 : C----------------------------------------------------------------I 200 : T1 = SQRT(1.5D0)*(1.0D0-XMAT(23))*HF*ANANS*PPT 201 : DO 78 I=1,NSTRS 202 : VARPT(2*NSTRS+I)= T1*ANS(I) 203 : 78 CONTINUE 204 : C----------------------------------------------------------------| 205 : C******* CALCULATION OF DQQ | 206 : C----------------------------------------------------------------I 207 : VARPT(4*NSTRS+3)=2.0D0*XMAT(24)*(XMAT(25)-VAR(4*NSTRS+3))*DQ 208 : C 209 : IF (MFR.EQ.5) THEN 210 : EPSVPT(1)=EPS0(1) 211 : EPSVPT(2)=EPS0(2) 212 : EPSVPT(3)=EPS0(4) 213 : EPSVPT(4)=EPS0(5) 214 : EPSVPT(5)=EPS0(6) 215 : ELSE 216 : DO 11 I=1,NSTRS 217 : EPSVPT(I)=EPS0(I) 218 : 11 CONTINUE 219 : ENDIF 220 : C 221 : RETURN 222 : END 223 : 224 : 225 : 226 : 227 :
© Cast3M 2003 - All rights reserved.
Disclaimer