Télécharger incre2.eso

Retour à la liste

Numérotation des lignes :

incre2
  1. C INCRE2 SOURCE CB215821 26/10/26 21:15:36 12682
  2. SUBROUTINE INCRE2(SIG,VAR,EPSVPT,VARPT,XMAT,XMAT0,NSTRS0,
  3. & MFR,NVARI,NCOMAT,VALMAT,VALMA0,DT0)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. DIMENSION SIG(*),VAR(*),EPSVPT(*),VARPT(*)
  7. DIMENSION XMAT(*),XMAT0(*),VALMAT(*),VALMA0(*)
  8. DIMENSION XX(6),XT1(6),XT2(6),AN(6),ANS(6),YY(6)
  9. DIMENSION SIG0(6),EPS0(6)
  10. LOGICAL IDT0
  11. PARAMETER (AMAX = 1.0D20 , AMIN = 1.D-10)
  12.  
  13. IDT0 = ABS(DT0).GT.0.D0
  14. DETIER = 2.0D0/3.0D0
  15. ROOT = SQRT(DETIER)
  16. C-------------------------------------------------------------------|
  17. C******* EVALUATION OF J2 SIGMA - X |
  18. C-------------------------------------------------------------------I
  19. IF (MFR.EQ.5) THEN
  20. NSTRS=6
  21. SIG0(1)=SIG(1)
  22. SIG0(2)=SIG(2)
  23. SIG0(3)=0.D0
  24. SIG0(4)=SIG(3)
  25. SIG0(5)=SIG(4)
  26. SIG0(6)=SIG(5)
  27. ELSE
  28. NSTRS=NSTRS0
  29. DO 10 I=1,NSTRS
  30. SIG0(I)=SIG(I)
  31. 10 CONTINUE
  32. ENDIF
  33. TRACE =(SIG0(1)+SIG0(2)+SIG0(3))/3.0D0
  34. DO 70 I=1,NSTRS
  35. A = 0.0D0
  36. IF (I.LE.3) A=1.0D0
  37. XX(I) = SIG0(I)-A*TRACE - VAR(I)-VAR(NSTRS+I)
  38. 70 CONTINUE
  39. AJ2 = PROCON (XX,XX,NSTRS)
  40. AJ2 = SQRT(1.5D0*AJ2)
  41. C--------------------------------------------------------------------|
  42. C******* CALCUL OF SIGV/K |
  43. C -------------------------------------------------------------------I
  44. RR = VAR (4*NSTRS+2)
  45. RS = XMAT(10)*RR
  46. SK = (AJ2 - RS-XMAT(7))/( XMAT(8) + XMAT(9)*RR )
  47. C--------------------------------------------------------------------|
  48. C******* CALCULATION OF EFFECTIVE INELASTIC STRAIN INCREMENT (P) |
  49. C -------------------------------------------------------------------I
  50. IF (SK.GT.0.0D0) THEN
  51. PPT1= XPUISS(SK,XMAT(6) ,AMAX)
  52. PPT2= XPUISS(SK,XMAT(6)+1.D0,AMAX)
  53. ELSE
  54. PPT1= 0.0D0
  55. PPT2= 0.0D0
  56. ENDIF
  57. T1 = XMAT(5)*PPT2
  58. PPT2=1.0D20
  59. IF(ABS(T1).LT.40.0D0) PPT2= EXP(T1)
  60. PPT = PPT1 * PPT2
  61. VARPT(4*NSTRS+1) = PPT
  62. C---------------------------------------------------------------------|
  63. C******* CALCULATION OF INELASTIC STRAIN INCREMENTS (EPSVPT) |
  64. C---------------------------------------------------------------------I
  65. DO 71 I=1,NSTRS,1
  66. IF (PPT.EQ.0.0) THEN
  67. EPS0 (I) = 0.0D0
  68. XX (I) = 0.0D0
  69. VARPT(3*NSTRS+I)= 0.0D0
  70. ELSE
  71. XX(I) = 1.5D0*XX(I)/AJ2
  72. EPS0 (I) = XX(I)*PPT
  73. VARPT(3*NSTRS+I)=EPS0 (I)
  74. ENDIF
  75. 71 CONTINUE
  76. C
  77. P = VAR(4*NSTRS+1)
  78. C----------------------------------------------------------------|
  79. C ******* CALCULATION OF PI(P) |
  80. C----------------------------------------------------------------I
  81. T1 = XMAT(16)*P
  82. T2 = EXP(-T1)
  83. PIP= XMAT(13)+(1.0D0-XMAT(13)) * T2
  84. C----------------------------------------------------------------|
  85. C******* CALCULATION OF XII |
  86. C----------------------------------------------------------------I
  87. DO 72 I=1,NSTRS
  88. XT1(I)=VAR(I)
  89. XT2(I)=VAR(I+NSTRS)
  90. 72 CONTINUE
  91. X1II = 0.0D0
  92. X2II = 0.0D0
  93. IF(XMAT(17).NE.0.0D0)
  94. . X1II = SQRT(1.5D0*PROCON(XT1,XT1,NSTRS))/XMAT(17)
  95. IF(XMAT(18).NE.0.0D0)
  96. . X2II = SQRT(1.5D0*PROCON(XT2,XT2,NSTRS))/XMAT(18)
  97. COX1 = 0.0D0
  98. COX2 = 0.0D0
  99. IF(X1II.GT.0.0D0) COX1 = X1II**(XMAT(19)-1.0D0)
  100. IF(X2II.GT.0.0D0) COX2 = X2II**(XMAT(20)-1.0D0)
  101. C ----------------------------------------------------------------|
  102. C******* CALCULATION OF DX1 AND DX2 |
  103. C-----------------------------------------------------------------I
  104. DO 73 I=1,NSTRS
  105. VARPT( I)=0.0D0
  106. VARPT(NSTRS+I)=0.0D0
  107. 73 CONTINUE
  108. DO 74 I=1,NSTRS
  109. T1 = DETIER * XMAT(11) * XMAT(12) * EPS0(I)
  110. DXMAT11 = XMAT(11) - XMAT0(11)
  111. XXMAT11 = XMAT(11) + XMAT0(11)
  112. IF (ABS(DXMAT11).GT.0.D0.AND.ABS(XXMAT11).GT.0.D0.AND.IDT0) THEN
  113. T1=T1+2.D0*VAR(I)*DXMAT11/XXMAT11/DT0
  114. ENDIF
  115. DXMAT12 = XMAT(12) - XMAT0(12)
  116. XXMAT12 = XMAT(12) + XMAT0(12)
  117. IF (ABS(DXMAT12).GT.0.D0.AND.ABS(XXMAT12).GT.0.D0.AND.IDT0) THEN
  118. T1=T1+2.D0*VAR(I)*DXMAT12/XXMAT12/DT0
  119. ENDIF
  120. T2 = XMAT(11) * PIP * XT1(I) * PPT
  121. T3 = COX1 * XT1(I)
  122. VARPT(I)= T1 - T2 -T3
  123. T1 = DETIER * XMAT(14) * XMAT(15) * EPS0(I)
  124. T2 = XMAT(14) * PIP * XT2(I) * PPT
  125. T3 = COX2 * XT2(I)
  126. VARPT(NSTRS+I)= T1 - T2 - T3
  127. 74 CONTINUE
  128. C-----------------------------------------------------------------|
  129. C******* CALCULATION OF DR |
  130. C-----------------------------------------------------------------I
  131. T1 = 1.0D0-(1.0D0-VAR(4*NSTRS+3)/XMAT(25))**2
  132. QR = VAR(4*NSTRS+3)-XMAT(26)*T1
  133. CO1= QR-VAR(4*NSTRS+2)
  134. CO = ABS(CO1)
  135. IF(CO.GT.0.0D0) CO = CO**(XMAT(22)-1.0D0)
  136. T1= XMAT(16)*(VAR(4*NSTRS+3)-VAR(4*NSTRS+2))*PPT
  137. T2= XMAT(21)*CO*CO1
  138. DR= T1 + T2
  139. VARPT(4*NSTRS+2)=DR
  140. C----------------------------------------------------------------|
  141. C******* CALCULATION OF PROD (N X N*) |
  142. C----------------------------------------------------------------I
  143. DO 75 I=1,NSTRS
  144. * A=1.0D0
  145. * IF(I.GT.3) A = 2.0D0
  146. YY(I)=VAR(3*NSTRS+I) - VAR(2*NSTRS+I)
  147. 75 CONTINUE
  148. AJ2= SQRT(1.5D0*PROCON(YY,YY,NSTRS))
  149. IF(AJ2.LT.AMIN) THEN
  150. IF (AJ2.EQ.0.D0) AJ2=AMIN
  151. AJ20=AJ2*1.D20
  152. DO 15 I=1,NSTRS
  153. YY(I)=YY(I)*1.D20
  154. 15 CONTINUE
  155. ELSE
  156. AJ20=AJ2
  157. ENDIF
  158. * IF (AJ2.LT.AMIN) AJ20=AMIN
  159. DO 76 I= 1,NSTRS
  160. ANS(I) = SQRT(1.5D0)*YY(I)/AJ20
  161. AN (I) = ROOT*XX(I)
  162. 76 CONTINUE
  163. FF = DETIER*AJ2-VAR(4*NSTRS+4)
  164. HF=0.0D0
  165. IF(FF.GT.0.0D0) HF=1.0D0
  166. ANAN1=PROCON(AN,ANS,NSTRS)
  167. ANANS=0.0D0
  168. IF(ANAN1.GT.0.0) ANANS=ANAN1
  169. C----------------------------------------------------------------|
  170. C******* CALCULATION OF DQ |
  171. C----------------------------------------------------------------I
  172. DQ = XMAT(23)*HF*ANANS*PPT
  173. VARPT(4*NSTRS+4)=DQ
  174. C----------------------------------------------------------------|
  175. C******* CALCULATION OF DGETA |
  176. C----------------------------------------------------------------I
  177. T1 = SQRT(1.5D0)*(1.0D0-XMAT(23))*HF*ANANS*PPT
  178. DO 78 I=1,NSTRS
  179. VARPT(2*NSTRS+I)= T1*ANS(I)
  180. 78 CONTINUE
  181. C----------------------------------------------------------------|
  182. C******* CALCULATION OF DQQ |
  183. C----------------------------------------------------------------I
  184. VARPT(4*NSTRS+3)=2.0D0*XMAT(24)*(XMAT(25)-VAR(4*NSTRS+3))*DQ
  185. C
  186. C Dependance de Q en temeprature (QT)
  187. DQT1 = VALMAT(28) - VALMA0(28)
  188. IF (ABS(DQT1).GT.0.D0.AND.IDT0) THEN
  189. VARPT(4*NSTRS+3)=VARPT(4*NSTRS+3)+DQT1/DT0
  190. ENDIF
  191. C
  192. IF (MFR.EQ.5) THEN
  193. EPSVPT(1)=EPS0(1)
  194. EPSVPT(2)=EPS0(2)
  195. EPSVPT(3)=EPS0(4)
  196. EPSVPT(4)=EPS0(5)
  197. EPSVPT(5)=EPS0(6)
  198. ELSE
  199. DO 11 I=1,NSTRS
  200. EPSVPT(I)=EPS0(I)
  201. 11 CONTINUE
  202. ENDIF
  203. C
  204. RETURN
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales