Télécharger acti1.eso

Retour à la liste

Numérotation des lignes :

  1. C ACTI1 SOURCE CB215821 16/04/21 21:15:02 8920
  2. C ACTI1 SOURCE
  3. SUBROUTINE ACTI1(SIG0,SIGF,D,NSTRSS,BETINSA)
  4. C
  5. C ===============================================================
  6. C Un seul critere de traction: DRUCKER PRAGER 3D
  7. C ================================================================
  8. C CE SOUS-PROGRAMME EST APPELE DANS "BONE3D".
  9. C
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. DIMENSION SIG0(NSTRSS),SIGF(NSTRSS)
  13. DIMENSION DFSIG(6),VEC1(6),DEPSI(6),SIGE(6)
  14. DIMENSION D(6,6),AC(6),A(6,6),AI(6,6),AIM(4,4)
  15. C
  16. SEGMENT BETINSA
  17. REAL*8 RT,RC,YOUN,XNU,GFT,GFC,CAR
  18. REAL*8 DKT,DKC,SEQT,SEQC,ENDT,ENDC
  19. INTEGER IFIS,IPLA,IBB,IGAU
  20. ENDSEGMENT
  21. C
  22. CALL ZERO(SIGE,6,1)
  23. DO 2 I=1,NSTRSS
  24. SIGE(I)=SIGF(I)
  25. 2 CONTINUE
  26. IAPEX=0
  27. PRB=1.D-5
  28. PRB2=1.D-2
  29. ITER=1
  30. ITR = 1500
  31. ITANG=0
  32. IBROY=0
  33. CRIMAX=0.D0
  34. SEQ = 0.D0
  35. SEQ1 = 0.D0
  36. C
  37. 8 CONTINUE
  38. C
  39. DO 4 I=1,NSTRSS
  40. SIGF(I)=SIGE(I)
  41. 4 CONTINUE
  42. DK=DKT
  43. DLAM0=0.D0
  44. CALL DRUTRA(SIGF,SEQTE,BETINSA)
  45. FCRI0 = SEQTE - SEQT
  46. CRIMAX=ABS(100.D0*FCRI0)
  47. 9 CONTINUE
  48. C
  49. C ************ CALCUL DU JACOBIEN INITIAL ********************
  50. C
  51. CALL DRUTR1(SIGF,DFSIG,BETINSA)
  52. C
  53. DO 25 I=1,NSTRSS
  54. AC(I)=0.D0
  55. DO 25 J=1,NSTRSS
  56. AC(I)=AC(I)+D(I,J)*DFSIG(J)
  57. 25 CONTINUE
  58. FDF=0.D0
  59. DO 30 J=1,NSTRSS
  60. FDF=FDF+DFSIG(J)*AC(J)
  61. 30 CONTINUE
  62. C
  63. CALL ENDAME(1,BETINSA)
  64. CALL FORECR(DK,PAEC,1,SEQ,BETINSA)
  65. C
  66. DJAC0=-(PAEC+FDF)
  67. C
  68. C ************ DEBUT ITERATION INTERNES ************************
  69. C
  70. 40 CONTINUE
  71. C
  72. C *************** Determination de DK *************************
  73. C
  74. DLAM1=-FCRI0/DJAC0+DLAM0
  75. DK=DKT+DLAM1
  76. C
  77. C *********** Estimation contrainte quivalente *****************
  78. C
  79. CALL ENDAME(1,BETINSA)
  80. CALL FORECR(DK,PAEC,1,SEQ,BETINSA)
  81. C
  82. C ************** Determination de DPHI *************************
  83. C
  84. CALL DRUTR2(SIGE,SEQ,DPHI,DLAM1,VEC1,BETINSA)
  85. C
  86. C **************** Cas de l'apex *******************************
  87. C
  88. IF (ABS(DPHI).LE.10E-10) THEN
  89. IAPEX=1
  90. DO 50 I=1,NSTRSS
  91. DO 50 J=1,NSTRSS
  92. AI(I,J)=0.D0
  93. 50 CONTINUE
  94. AI(1,1)=1./3.
  95. AI(1,2)=AI(1,1)
  96. AI(1,2)=AI(1,1)
  97. AI(1,3)=AI(1,1)
  98. AI(2,1)=AI(1,1)
  99. AI(2,2)=AI(1,1)
  100. AI(2,3)=AI(1,1)
  101. AI(3,1)=AI(1,1)
  102. AI(3,2)=AI(1,1)
  103. AI(3,3)=AI(1,1)
  104. GOTO 75
  105. ENDIF
  106. C
  107. C ************** Mise a jour des contraintes ***************
  108. C
  109. C ---------------- calcul de la matrice A ------------------
  110. C
  111. DO 60 I=1,NSTRSS
  112. DO 60 J=1,NSTRSS
  113. A(I,J)=0.D0
  114. 60 CONTINUE
  115. C
  116. DG=YOUN/(1.D0+XNU)
  117. C
  118. A(1,1)=1.D0+2.*(DLAM1*DG)/2.D0/DPHI
  119. A(2,2)=A(1,1)
  120. A(3,3)=A(1,1)
  121. A(1,2)=-(DLAM1*DG)/2.D0/DPHI
  122. A(1,3)=A(1,2)
  123. A(2,1)=A(1,2)
  124. A(2,3)=A(1,2)
  125. A(3,1)=A(1,2)
  126. A(3,2)=A(1,2)
  127. A(4,4)=1.D0+3.*(DLAM1*DG)/2.D0/DPHI
  128. A(5,5)=A(4,4)
  129. A(6,6)=A(4,4)
  130. C
  131. C -------------- invertion de la matrice A -----------------
  132. C
  133. CALL ZERO(AI,6,6)
  134. CALL ZERO(AIM,6,6)
  135. C
  136. DO 70 I=1,3
  137. DO 70 J=1,3
  138. AIM(I,J)=A(I,J)
  139. 70 CONTINUE
  140. CALL INVMA2(AIM,3,ISING)
  141. IF (ISING.EQ.1) THEN
  142. WRITE(*,*)'MATRICE AIM singuliere ds ACTI1'
  143. ENDIF
  144. DO 72 I=1,3
  145. DO 72 J=1,3
  146. AI(I,J)=AIM(I,J)
  147. 72 CONTINUE
  148. AI(4,4) = 1./A(4,4)
  149. AI(5,5) = 1./A(5,5)
  150. AI(6,6) = 1./A(6,6)
  151. C
  152. C -------------- mise a jour des contraintes ------------
  153. C
  154. 75 CONTINUE
  155. C
  156. DO 80 I=1,NSTRSS
  157. DEPSI(I)=SIGE(I)-DLAM1*VEC1(I)
  158. 80 CONTINUE
  159. C
  160. DO 90 I=1,NSTRSS
  161. SIGF(I)=0.
  162. DO 90 J=1,NSTRSS
  163. SIGF(I)=SIGF(I)+AI(I,J)*DEPSI(J)
  164. 90 CONTINUE
  165. C
  166. C ******** VERIFICATION DU CRITERE ****************
  167. C
  168. CALL DRUTRA(SIGF,SEQI,BETINSA)
  169. FCRI1 = SEQI - SEQ
  170. C
  171. IF (IBROY.EQ.0.AND.ABS(FCRI1).GE.CRIMAX) THEN
  172. C WRITE(*,*)'****************************************'
  173. C WRITE(*,*)'LE RESIDU DIVERGE AVEC BROYDEN'
  174. C WRITE(*,*)'on passe donc a la secante'
  175. C WRITE(*,*)'Dans l element',IBB
  176. C WRITE(*,*)'et au point d intégration',IGAU
  177. C WRITE(*,*)'CRIMAX=',CRIMAX
  178. C WRITE(*,*)'****************************************'
  179. ITER=ITR
  180. ENDIF
  181. C
  182. C ******* Compteur sur la methode de resolution ****
  183. C
  184. IF (IBROY.EQ.0.AND.ITER.EQ.ITR) THEN
  185. IBROY=1
  186. ITANG=1
  187. ITER=1
  188. IAPEX=0
  189. GOTO 8
  190. ENDIF
  191. C
  192. C ******* non convergence **************************
  193. C
  194. IF (ABS(FCRI1).GT.PRB.AND.ITER.LT.ITR) THEN
  195. IF (IBROY.EQ.0) THEN
  196. DJAC1=(FCRI0-FCRI1)/(DLAM0-DLAM1)
  197. DLAM0=DLAM1
  198. DJAC0=DJAC1
  199. FCRI0=FCRI1
  200. ITER=ITER+1
  201. GOTO 40
  202. ENDIF
  203. IF (IBROY.EQ.1.AND.ITANG.EQ.1) THEN
  204. DLAM0=DLAM1
  205. FCRI0=FCRI1
  206. ITER=ITER+1
  207. IF (ITER.GE.(ITR-5)) THEN
  208. WRITE(*,*)'ITER=',ITER
  209. WRITE(*,*)'FCRI=',FCRI1
  210. ENDIF
  211. GOTO 9
  212. ENDIF
  213. ENDIF
  214. IF (ITER.GE.ITR.AND.ABS(FCRI1).GT.PRB2) THEN
  215. WRITE(*,*)'NON CONVERGENCE INTERNE dans ACTI1'
  216. WRITE(*,*)'FCRI=',FCRI1
  217. WRITE(*,*)'Dans l element',IBB
  218. WRITE(*,*)'et au point d intégration',IGAU
  219. STOP
  220. ENDIF
  221. C
  222. C ******* convergence **************************
  223. C
  224. SEQT = SEQ
  225. DKT = DK
  226. C
  227. C ***********************************************
  228. C
  229. 100 CONTINUE
  230. C
  231. RETURN
  232. END
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  

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