Télécharger incre5.eso

Retour à la liste

Numérotation des lignes :

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

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