Télécharger ccoin0.eso

Retour à la liste

Numérotation des lignes :

  1. C CCOIN0 SOURCE KICH 18/10/08 21:15:05 9949
  2.  
  3. SUBROUTINE CCOIN0(wrk52,wrk53,wrk54,wrk2,wrk3,
  4. & IB,IGAU,NBPGAU,LTRAC,IFOURB,iecou)
  5.  
  6. C-----------------------------------------------------------------------
  7. C ECOULEMENT PLASTIQUE POUR UN POINT
  8. C ALGORITHME ORTIZ ET SIMO
  9. C
  10. C EN ENTREE :
  11. C
  12. C SIG0 CONTRAINTES AU DEBUT DU PAS
  13. C DEPST INCREMENT DE DEFORMATIONS TOTALES
  14. C ( THERMIQUE ENLEVEE )
  15. C VAR0 VARIABLES INTERNES DEDUT DU PAS
  16. C VAREX0 VARIABLES EXTERNES DEBUT DU PAS
  17. C VAREXF VARIABLES EXTERNES FIN DU PAS
  18. C XMAT COEFFICIENTS DU MATERIAU
  19. C PRECIS PRECISION POUR ITERATIONS INTERNES
  20. C WORK DES CARACTERISTIQUES
  21. C TRAC COURBE DE TRACTION
  22. C MFR1 INDICE DE FORMULATION
  23. C NSTRSS NOMBRE DE CONTRAINTES CA2000
  24. C INPLAS NUMERO DU MODELE DE PLASTICITE
  25. C DDAUX = MATRICE DE HOOKE ELASTIQUE
  26. C CMATE = NOM DU MATERIAU
  27. C VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  28. C VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  29. C N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  30. C N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  31. C IFOU = OPTION DE CALCUL
  32. C IB = NUMERO DE L ELEMENT COURANT
  33. C IGAU = NUMERO DU POINT COURANT
  34. C EPAIST= EPAISSEUR
  35. C NBPGAU= NBRE DE POINTS DE GAUSS
  36. C MELE = NUMERO DE L ELEMENT FINI
  37. C NPINT = NBRE DE POINTS D INTEGRATION
  38. C NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  39. C NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  40. C SECT = SECTION
  41. C LHOOK = TAILLE DE LA MATRICE DE HOOKE
  42. C TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
  43. C UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE
  44. C
  45. C EN SORTIE :
  46. C
  47. C SIGF CONTRAINTES A LA FIN DU PAS
  48. C VARF VARIABLES INTERNES FIN DU PAS
  49. C DEFP INCR. DE DEFORMATIONS PLASTIQUES
  50. C KERRE CODE D'ERREUR
  51. C = 0 SI TOUT OK
  52. C = 99 SI FORMULATION NON DISPONIBLE
  53. C EN PLASTICITE
  54. C = 1 SI DEPS EST NEGATIF
  55. C = 2 SI NOMBRE MAX D'ITERATIONS INTERNES DEPASSE
  56. C
  57. C IFOUR : OPTION DE CALCUL
  58. C
  59. C IFOUR = -3 DEFORMATION PLANE GENERALISEE
  60. C IFOUR = -2 CONTRAINTES PLANES
  61. C IFOUR = -1 DEFORMATIONS PLANES
  62. C IFOUR = 0 AXISYMETRIQUE
  63. C IFOUR = 1 SERIE DE FOURIER
  64. C IFOUR = 2 TRIDIMENSIONNEL
  65. C
  66. C MFR1 : NUMERO DE LA FORMULATION ELEMENT FINI
  67. C
  68. C MFR1 = 1 MASSIF
  69. C MFR1 = 3 COQUE
  70. C MFR1 = 5 COQUE EPAISSE
  71. C MFR1 = 7 POUTRE
  72. C MFR1 = 9 COQUE AVEC CISAILLEMENT TRANSVERSE
  73. Ckich MFR1 = 31 pondération réduite termes diagonaux matrice B,
  74. C dite MASSIF INCOMPRESSIBLE. Utilisation en contraintes planes a justifier
  75. c doublon historique MFR/MFR1
  76. C
  77. C INPLAS : NUMERO DU MODELE DE PLASTICITE
  78. C
  79. C INPLAS = 1 PARFAIT
  80. C INPLAS = 4 CINEMATIQUE
  81. C INPLAS = 5 ISOTROPE
  82. C INPLAS = 7 CHABOCHE1
  83. C INPLAS = 12 CHABOCHE2
  84. C
  85. C-----------------------------------------------------------------------
  86. C CONVENTION DE REMPLISSAGE DES MEMOIRES
  87. C-----------------------------------------------------------------------
  88. C
  89. C XMAT(1) MODULE D'YOUNG
  90. C XMAT(2) COEFFICIENT DE POISSON
  91. C
  92. C TRAC(1 A 2*LTRAC) COURBE DE TRACTION
  93. C WORK( " +1) ALFAH POUR COQUES PLASTICITE GLOBALE
  94. C WORK( " +..) DONNEES POUR CRITERE POUTRES GLOBALES
  95. C
  96. C MODELE ISOTROPE
  97. C VAR0(1) EPS*
  98. C
  99. C MODELE CINEMATIQUE LINEAIRE
  100. C VAR0(1) EPS*
  101. C VAR0(2) A VAR0(1+NSTRSS) DEPLACEMENT DE LA SPHERE
  102. C
  103. C MODELE CHABOCHE
  104. C XMAT(5) .... COEFFICIENTS A,C,...
  105. C VAR0(1) EPS*
  106. C VAR0(2) A VAR0(1+NSTRSS) DEPLACEMENT DE LA SPHERE 1
  107. C VAR0(2+NSTRSS) A VAR0(1+2*NSTRSS) " " " " 2
  108. C
  109. C-----------------------------------------------------------------------
  110. C 20/09/2017 : modif SG critere de convergence trop serre
  111. C TEST=PETI*APHI0 + utilisation CCREEL
  112. C voir aussi ecoin0.eso, syco12.eso
  113.  
  114. IMPLICIT INTEGER(I-N)
  115. IMPLICIT REAL*8(A-H,O-Z)
  116. -INC CCOPTIO
  117. -INC CCREEL
  118. -INC DECHE
  119.  
  120. SEGMENT IECOU
  121. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  122. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  123. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  124. 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
  125. 4 icow32,icow33,NSTRSS,MFR1, NBGMAT,NELMAT,icow38,
  126. 5 icow39,icow40,icow41,icow42,icow43,icow44
  127. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  128. . icow51,icow52,icow53,icow54,icow55,icow56
  129. . icow57,icow58
  130. ENDSEGMENT
  131. *
  132. SEGMENT WRK2
  133. REAL*8 TRAC(LTRAC)
  134. ENDSEGMENT
  135. *
  136. SEGMENT WRK3
  137. REAL*8 WORK(LW),WORK2(LW2)
  138. ENDSEGMENT
  139.  
  140. DIMENSION SIG(130),EPS(130)
  141. DIMENSION S(8),SX(8),DS(8),DSIG(8),SPHER(8),SPHER1(8),SPHER2(8)
  142. DIMENSION DSPHER1(8),DSPHER2(8),DEPSE(8),DEPSP(8),DDEPSE(8)
  143. DIMENSION F(8),W1(8),W2(8),SIGB(8),Z1(8),DIV(8),DDA(8,8)
  144. DIMENSION CRIGI(12)
  145. * logical lvisu
  146.  
  147. * lvisu = ib.eq.125.and.(igau.eq.1.or.igau.eq.5)
  148.  
  149. ncara = commat(/2)
  150. if(ib.eq.1.and.igau.eq.1) then
  151. do iaca = 1,ncara
  152. if(commat(iaca).eq.'LIMP') icow21 = iaca
  153. enddo
  154. endif
  155. if(icow21.gt.0) xlimp = valma0(icow21)
  156. do jj = 1,8
  157. sx(jj) = 0.d0
  158. enddo
  159. C---------COQUES AVEC CT------------------------------------------------
  160. C ON NE TRAVAILLE QUE SUR LES 6 PREMIERES COMPOSANTES
  161. IF(MFR1.EQ.9) THEN
  162. NCONT=6
  163. ELSE
  164. NCONT=NSTRSS
  165. ENDIF
  166. itracb=0
  167. 2222 continue
  168.  
  169. C-----------------------------------------------------------------------
  170. DO I=1,NSTRSS
  171. S(I)=0.D0
  172. SPHER(I)=0.D0
  173. SPHER1(I)=0.D0
  174. SPHER2(I)=0.D0
  175. ENDDO
  176. KERRE=0
  177. YUNG=XMAT(1)
  178. XNU=XMAT(2)
  179.  
  180. C---------CARACTERISTIQUES GEOMETRIQUES---------------------------------
  181. C
  182. C COQUES
  183. C
  184. ALFAH=1.D0
  185. IF(MFR1.EQ.3.OR.MFR1.EQ.5.OR.MFR1.EQ.9) THEN
  186. EP1=WORK(1)
  187. IF(MFR1.NE.5) ALFAH=WORK(2)**2
  188. ENDIF
  189.  
  190. C---------COEFFICIENTS CHABOCHE-----------------------------------------
  191.  
  192. IF(INPLAS.EQ.7) THEN
  193. A1=XMAT(5)
  194. C1=XMAT(6)
  195. R0=XMAT(7)
  196. PSI=XMAT(8)
  197. OME=XMAT(9)
  198. RM=XMAT(10)
  199. B=XMAT(11)
  200. A2=0.D0
  201. C2=0.D0
  202. ELSE IF(INPLAS.EQ.12) THEN
  203. A1=XMAT(5)
  204. C1=XMAT(6)
  205. A2=XMAT(7)
  206. C2=XMAT(8)
  207. R0=XMAT(9)
  208. PSI=XMAT(10)
  209. OME=XMAT(11)
  210. RM=XMAT(12)
  211. B=XMAT(13)
  212. ELSE
  213. DO I=1,LTRAC
  214. SIG(I)=TRAC(2*I-1)
  215. EPS(I)=TRAC(2*I)
  216. ENDDO
  217. ENDIF
  218.  
  219. EPST=VAR0(1)
  220. C---------ECROUISSAGE CINEMATIQUE---------------------------------------
  221.  
  222. IF(INPLAS.EQ.4.OR.INPLAS.EQ.7.OR.INPLAS.EQ.12) THEN
  223. DO I=1,NSTRSS
  224. SPHER1(I)=VAR0(I+1)
  225. ENDDO
  226. IF(INPLAS.EQ.12) THEN
  227. DO I=1,NSTRSS
  228. SPHER2(I)=VAR0(NSTRSS+1+I)
  229. ENDDO
  230. ENDIF
  231. DO I=1,NSTRSS
  232. SPHER(I)=SPHER1(I)+SPHER2(I)
  233. ENDDO
  234. C-----------------------------------------------------------------------
  235. C PREDICTEUR ELASTIQUE
  236. C S : CONTRAINTE
  237. C SPHER : VARIABLE D'ECROUISSAGE CINEMATIQUE
  238. C SX = S - X
  239. C-----------------------------------------------------------------------
  240.  
  241. * en elastique non lineaire on annule les contraintes initiales
  242. * mais on cumule les epsilons elastiques
  243. ELSE IF(INPLAS.EQ.87) THEN
  244. EPST=0.D0
  245. DO I=1,NSTRSS
  246. SIG0(I)=0.D0
  247. DEPST(I)=DEPST(I) + VAR0(I+1)
  248. ENDDO
  249. ENDIF
  250. CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,
  251. & N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,
  252. & NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  253. & XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  254.  
  255. IF(IRTD.NE.1) THEN
  256. KERRE=69
  257. GOTO 1000
  258. ENDIF
  259.  
  260. IF ((mfr.eq.1.or.mfr.eq.31).and. ifourb.eq.-2) then
  261. * en cas de contraintes planes on repasse en 3D
  262. do ju=1,6
  263. do iu=1,6
  264. DDA(iu,ju)=0.d0
  265. enddo
  266. enddo
  267. cte_cp = xnu / (1.d0 - xnu)
  268. aux= YUNG / ((1.d0+xnu)*(1.d0-2.d0*xnu))
  269. aux1= aux * xnu
  270. aux2= aux * (1.d0-xnu)
  271. gege = Yung / (2.d0 *(1.d0 +xnu))
  272. DDA(1,1)=AUX2
  273. DDA(2,1)=AUX1
  274. DDA(1,2)=AUX1
  275. DDA(2,2)=AUX2
  276. DDA(3,3)=aux2
  277. DDA(1,3)=aux1
  278. DDA(2,3)=aux1
  279. DDA(3,1)=aux1
  280. DDA(3,2)=aux1
  281. DDA(4,4)=gege
  282. DDA(5,5)=gege
  283. DDA(6,6)=GEGE
  284.  
  285. ELSE IF ((MFR.EQ.3.AND.NPINT.EQ.0).OR.MFR.EQ.9) THEN
  286. AUX=YUNG/(1.D0-XNU*XNU)
  287. AUX1=AUX*XNU
  288. DO J=1,NCONT
  289. DO I=1,NCONT
  290. DDAUX(I,J)=0.D0
  291. ENDDO
  292. ENDDO
  293. C
  294. C CAS TRIDIMENSIONNEL ET FOURIER
  295. C
  296. IF(IFOURB.EQ.2.OR.IFOURB.EQ.1) THEN
  297.  
  298. GEGE=0.5D0*YUNG/(1.D0+XNU)
  299. DDAUX(1,1)=AUX
  300. DDAUX(2,1)=AUX1
  301. DDAUX(1,2)=AUX1
  302. DDAUX(2,2)=AUX
  303. DDAUX(3,3)=GEGE
  304. DDAUX(4,4)=AUX
  305. DDAUX(5,4)=AUX1
  306. DDAUX(4,5)=AUX1
  307. DDAUX(5,5)=AUX
  308. DDAUX(6,6)=GEGE
  309. C
  310. C CAS AXISYMETRIQUE ET DEFORMATIONS PLANES
  311. C
  312. ELSE IF(IFOURB.EQ.0.OR.IFOURB.EQ.-1.OR.IFOURB.EQ.-3) THEN
  313.  
  314. DDAUX(1,1)=AUX
  315. DDAUX(2,1)=AUX1
  316. DDAUX(1,2)=AUX1
  317. DDAUX(2,2)=AUX
  318. DDAUX(3,3)=AUX
  319. DDAUX(4,3)=AUX1
  320. DDAUX(3,4)=AUX1
  321. DDAUX(4,4)=AUX
  322. C
  323. C CAS CONTRAINTES PLANES
  324. C
  325. ELSE IF(IFOURB.EQ.-2) THEN
  326. DDAUX(1,1)=YUNG
  327. DDAUX(3,3)=YUNG
  328. ENDIF
  329. ENDIF
  330. *
  331. DO I=1,NSTRSS
  332. S(I)=SIG0(I)+DSIGT(I)
  333. SIGB(I)=S(I)
  334. SX(I)=S(I)-SPHER(I)
  335. ENDDO
  336.  
  337. C---------CAS DES POUTRES-----------------------------------------------
  338.  
  339. IF(MFR1.EQ.7) THEN
  340. DIV(1)=1.D0/WORK(4)
  341. DIV(2)=1.D0
  342. DIV(3)=1.D0
  343. DIV(4)=WORK(10)/WORK(1)
  344. DIV(5)=WORK(11)/WORK(2)
  345. DIV(6)=WORK(12)/WORK(3)
  346. IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(WORK(1)*WORK(4))
  347. IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(WORK(2)*WORK(4))
  348. IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(WORK(3)*WORK(4))
  349. DO I=1,NCONT
  350. S(I)=S(I)*DIV(I)
  351. SX(I)=SX(I)*DIV(I)
  352. ENDDO
  353. ENDIF
  354.  
  355. C-----------------------------------------------------------------------
  356. C CALCUL DE LA LIMITE ELASTIQUE SI
  357. C-----------------------------------------------------------------------
  358.  
  359. IF(INPLAS.EQ.1.OR.INPLAS.EQ.4) THEN
  360. SI=TRAC(1)
  361. ELSE IF(INPLAS.EQ.5.OR.INPLAS.EQ.87) THEN
  362. CALL TRACTI(SI,EPST,SIG,EPS,LTRAC,2,IBI)
  363. IF(IBI.EQ.1) THEN
  364. KERRE=75
  365. GOTO 1000
  366. ENDIF
  367. C* Modele de CHABOCHE (prise en compte ecrouissage)
  368. ELSE IF (INPLAS.EQ.7 .OR. INPLAS.EQ.12) THEN
  369. RMmRR = (RM - R0) * EXP(-B*EPST)
  370. SI = RM - RMmRR
  371. ENDIF
  372.  
  373. **
  374. * kich : application pression limite trace sigma
  375. **
  376.  
  377. yxsxii = 0.d0
  378. if (icow21.gt.0) then
  379. ytr = sx(1) + sx(2) + sx(3)
  380. ytr = ytr/3.D0
  381. if (ytr.gt.xlimp) then
  382. yxsxii = ytr - xlimp
  383. else if((ytr + xlimp).lt.0) then
  384. yxsxii = ytr + xlimp
  385. endif
  386. if(ysxii.ne.0) then
  387. dsigii = dsigt(1) + dsigt(2) + dsigt(3)
  388. if(dsigii.ne.0.D0) then
  389. do jj = 1,3
  390. s(jj) = s(jj) - (dsigt(jj)/dsigii*3.D0*yxsxii)
  391. sx(jj) = sx(jj) - (dsigt(jj)/dsigii*3.D0*yxsxii)
  392. enddo
  393. else
  394. do jj = 1,3
  395. s(jj) = s(jj) - yxsxii
  396. sx(jj) = sx(jj) - yxsxii
  397. enddo
  398. endif
  399. endif
  400. endif
  401. C-----------------------------------------------------------------------
  402. C CALCUL DE LA CONTRAINTE EQUIVALENTE SEQ
  403. C-----------------------------------------------------------------------
  404. * attention en contraintes planes on se declare en 3D
  405. * rien besoin de faire dans vonmis0 car ifourb n'est pas utilise
  406. * et les contraintes sont dimensionnees a 6
  407. SEQ=VONMIS0(SX,NSTRSS,MFR1,IFOURB,EP1,ALFAH)
  408.  
  409. C-----------------------------------------------------------------------
  410. C LE CRITERE EST-IL VERIFIE
  411. C-----------------------------------------------------------------------
  412. PHI=SEQ-SI
  413. NITER=0
  414. PETI=1.1D0*0.5D0*PRECIS*SEQ
  415. *sg write(ioimp,*) 'niter,phi,si,seq,peti,precis=',
  416. *sg $ niter,phi,si,seq,peti,precis
  417. CALL EPSPRE(SEQ,SI,PETI,ITRY)
  418. IF((ITRY.EQ.1).OR.(SEQ.LE.SI)) THEN
  419. * rien a faire on n'a pas plastifie
  420. IF(MFR1.EQ.7) THEN
  421. DO I=1,NCONT
  422. S(I)=S(I)/DIV(I)
  423. ENDDO
  424. ENDIF
  425. DO I=1,NCONT
  426. SIGF(I)=S(I)
  427. DEFP(I)=0.D0
  428. ENDDO
  429. IF(MFR1.EQ.9) THEN
  430. DEFP(7)=0.D0
  431. DEFP(8)=0.D0
  432. SIGF(7)=S(7)
  433. SIGF(8)=S(8)
  434. ENDIF
  435.  
  436. VARF(1)=VAR0(1)
  437. IF(INPLAS.EQ.4.OR.INPLAS.EQ.7) THEN
  438. DO I=1,NSTRSS
  439. VARF(I+1)=VAR0(I+1)
  440. ENDDO
  441. ELSE IF(INPLAS.EQ.12) THEN
  442. DO I=1,2*NSTRSS
  443. VARF(I+1)=VAR0(I+1)
  444. ENDDO
  445. ELSE IF(INPLAS.EQ.87) THEN
  446. DO I=1,NSTRSS
  447. VARF(I+1)=DEPST(I)
  448. ENDDO
  449. ENDIF
  450. RETURN
  451. ENDIF
  452.  
  453. C-----------------------------------------------------------------------
  454. C ON A PLASTIFIE
  455. C-----------------------------------------------------------------------
  456. cri0= si * 1.D-8
  457. PHI0=PHI
  458. SI0=SI
  459. RR=0.D0
  460.  
  461. DO I=1,NCONT
  462. DSIG(I) =0.D0
  463. DEPSP(I) =0.D0
  464. DSPHER1(I)=0.D0
  465. DSPHER2(I)=0.D0
  466. ENDDO
  467.  
  468. C-----------------------------------------------------------------------
  469. C DEBUT DE LA BOUCLE D'ITERATIONS INTERNES
  470. C-----------------------------------------------------------------------
  471. sx1in=sx(1)
  472. sx2in=sx(2)
  473. sx3in= sx(3)
  474. s1in=s(1)
  475. s2in=s(2)
  476.  
  477. iderin=0
  478. 10 CONTINUE
  479. NITER=NITER+1
  480.  
  481. phi= seq - si
  482.  
  483. C---------CALCUL DE W1=DF/D(SIGMA)--------------------------------------
  484.  
  485. C---------ELEMENTS MASSIFS----------------------------------------------
  486.  
  487. IF(MFR1.EQ.1.OR.MFR1.EQ.31) THEN
  488.  
  489. F(1)=(2.D0*SX(1)-SX(2)-SX(3))/3.D0
  490. F(2)=(2.D0*SX(2)-SX(1)-SX(3))/3.D0
  491. F(3)=(2.D0*SX(3)-SX(1)-SX(2))/3.D0
  492. DO I=4,NSTRSS
  493. F(I)=SX(I)
  494. ENDDO
  495. DO I=1,3
  496. W1(I)=1.5D0*F(I)/SEQ
  497. Z1(I)=W1(I)
  498. ENDDO
  499. DO I=4,NCONT
  500. W1(I)=3.D0*F(I)/SEQ
  501. Z1(I)=1.5D0*F(I)/SEQ
  502. ENDDO
  503.  
  504. C---------COQUES MINCES-------------------------------------------------
  505.  
  506. ELSE IF(MFR1.EQ.3.OR.MFR1.EQ.9) THEN
  507.  
  508. IF(IFOURB.GE.1) THEN
  509. W1(1)=(2.D0*SX(1)-SX(2))/(2.D0*SEQ*EP1)
  510. W1(2)=(2.D0*SX(2)-SX(1))/(2.D0*SEQ*EP1)
  511. W1(3)=3.D0*SX(3)/(SEQ*EP1)
  512. W1(4)=3.D0*WORK(2)*(2.D0*SX(4)-SX(5))/(SEQ*EP1*EP1)
  513. W1(5)=3.D0*WORK(2)*(2.D0*SX(5)-SX(4))/(SEQ*EP1*EP1)
  514. W1(6)=18.D0*WORK(2)*SX(6)/(SEQ*EP1*EP1)
  515. ELSE
  516. W1(1)=(2.D0*SX(1)-SX(2))/(2.D0*SEQ*EP1)
  517. W1(2)=(2.D0*SX(2)-SX(1))/(2.D0*SEQ*EP1)
  518. W1(3)=3.D0*WORK(2)*(2.D0*SX(3)-SX(4))/(SEQ*EP1*EP1)
  519. W1(4)=3.D0*WORK(2)*(2.D0*SX(4)-SX(3))/(SEQ*EP1*EP1)
  520. ENDIF
  521.  
  522.  
  523. C---------COQUES EPAISSES-----------------------------------------------
  524. ELSE IF(MFR1.EQ.5) THEN
  525. F(1)=(2.D0*SX(1)-SX(2))/3.D0
  526. F(2)=(2.D0*SX(2)-SX(1))/3.D0
  527. DO I=3,5
  528. F(I)=SX(I)
  529. ENDDO
  530. DO I=1,2
  531. W1(I)=1.5D0*F(I)/SEQ
  532. Z1(I)=W1(I)
  533. ENDDO
  534. DO I=3,5
  535. W1(I)=3.D0*F(I)/SEQ
  536. Z1(I)=1.5D0*F(I)/SEQ
  537. ENDDO
  538.  
  539. C---------POUTRES-------------------------------------------------------
  540.  
  541. ELSE IF(MFR1.EQ.7) THEN
  542.  
  543. DO J=1,NCONT
  544. DO I=1,NCONT
  545. DDA(I,J)=0.D0
  546. ENDDO
  547. ENDDO
  548. DDA(1,1)=YUNG
  549. DDA(4,4)=0.5D0*YUNG/(1.D0+XNU)
  550. DDA(5,5)=YUNG
  551. DDA(6,6)=YUNG
  552. W1(1)=SX(1)/SEQ
  553. W1(2)=0.D0
  554. W1(3)=0.D0
  555. W1(4)=SX(4)/SEQ
  556. W1(5)=SX(5)/SEQ
  557. W1(6)=SX(6)/SEQ
  558. ENDIF
  559.  
  560. IF(MFR1.EQ.7) THEN
  561. DO I=1,NCONT
  562. W2(I)=0.D0
  563. ENDDO
  564. DO J=1,NCONT
  565. XFLO1=W1(J)
  566. DO I=1,NCONT
  567. W2(I)=W2(I)+XFLO1*DDA(I,J)
  568. ENDDO
  569. ENDDO
  570.  
  571. ELSE
  572. IF((mfr.eq.1.or.mfr.eq.31).and. ifourb.eq.-2) then
  573. DO I=1,NCONT
  574. W2(I)=0.D0
  575. ENDDO
  576. DO J=1,NCONT
  577. XFLO1=W1(J)
  578. DO I=1,NCONT
  579. W2(I)=W2(I)+XFLO1*DDA(I,J)
  580. ENDDO
  581. ENDDO
  582. else
  583. DO I=1,NCONT
  584. W2(I)=0.D0
  585. ENDDO
  586. DO J=1,NCONT
  587. XFLO1=W1(J)
  588. DO I=1,NCONT
  589. W2(I)=W2(I)+XFLO1*DDAUX(I,J)
  590. ENDDO
  591. ENDDO
  592. endif
  593. ENDIF
  594. COEF=0.D0
  595. DO I=1,NCONT
  596. COEF=COEF+W1(I)*W2(I)
  597. ENDDO
  598.  
  599. C-----------------------------------------------------------------------
  600. C PLASTICITE PARFAITE, ECROUISSAGE ISOTROPE ET CINEMATIQUE ZIEGLER
  601. C-----------------------------------------------------------------------
  602.  
  603. IF(INPLAS.EQ.1.OR.INPLAS.EQ.4.OR.INPLAS.EQ.5
  604. $ .OR.INPLAS.EQ.87) THEN
  605. CALL TRACTI(PENTE,EPST,SIG,EPS,LTRAC,1,IBI)
  606.  
  607. IF(IBI.EQ.1) THEN
  608. KERRE=75
  609. GOTO 1000
  610. ENDIF
  611.  
  612. IF(INPLAS.EQ.1) THEN
  613. RP=0.D0
  614. C=0.D0
  615. ELSE IF(INPLAS.EQ.4) THEN
  616. RP=0.D0
  617. ELSE IF(INPLAS.EQ.5.OR.INPLAS.EQ.87) THEN
  618. RP=PENTE
  619. C=0.D0
  620. ENDIF
  621.  
  622. DENOM=COEF+C+RP
  623. DELTA=PHI/DENOM
  624. DMU=C*DELTA/SEQ
  625.  
  626. DO I=1,NCONT
  627. DSIG(I)=-DELTA*W2(I)
  628. DSPHER1(I)=DMU*SX(I)
  629. ENDDO
  630.  
  631. * Cas des contraintes planes en massif
  632. if((mfr.eq.1.or.mfr.eq.31).and.ifourb.eq.-2) then
  633.  
  634. bb= abs(dsig(3)+ s(3) )
  635. r_z = dsig(3) * cte_cp
  636. sx(3)= sx3in - dsig(3)
  637. sx(1)= sx1in - r_z
  638. sx(2)= sx2in - r_z
  639. SEQ=VONMIS0(SX,NSTRSS,MFR1,IFOURB,EP1,ALFAH)
  640. s(3)= - dsig(3)
  641. s(1)= s1in - r_z
  642. s(2)= s2in - r_z
  643. if( bb.gt.cri0) then
  644. if(iderin.eq.0) then
  645. niter=niter - 1
  646. endif
  647. iderin=iderin+1
  648. if(iderin.gt.50) then
  649. write(ioimp,*) ' probleme dans iterations internes'
  650. KERRE=2
  651. GO TO 1000
  652. endif
  653. go to 10
  654. endif
  655. DMU=C*DELTA/SEQ
  656. DO I=1,NCONT
  657. DSPHER1(I)=DMU*SX(I)
  658. ENDDO
  659. endif
  660. iderin=0
  661. DP=DELTA
  662. DR=RP*DP
  663.  
  664. ELSE
  665.  
  666. C-----------------------------------------------------------------------
  667. C MODELE DE CHABOCHE
  668. C-----------------------------------------------------------------------
  669.  
  670. C---------UNIQUEMENT POUR LES ELEMENTS MASSIFS--------------------------
  671.  
  672. XPRO1=0.D0
  673. XPRO2=0.D0
  674. DO I=1,NCONT
  675. XPRO1=XPRO1+W1(I)*SPHER1(I)
  676. XPRO2=XPRO2+W1(I)*SPHER2(I)
  677. ENDDO
  678.  
  679. FIP=1.D0+(PSI-1.D0)*EXP(-OME*EPST)
  680.  
  681. DENOM=COEF+(A1*C1+A2*C2)*FIP-C1*XPRO1-C2*XPRO2+B*RMmRR
  682. DELTA=PHI/DENOM
  683.  
  684. DO I=1,NCONT
  685. DSIG(I)=-DELTA*W2(I)
  686. DSPHER1(I)=(2.D0*A1*FIP*Z1(I)/3.D0-SPHER1(I))*C1*DELTA
  687. DSPHER2(I)=(2.D0*A2*FIP*Z1(I)/3.D0-SPHER2(I))*C2*DELTA
  688. ENDDO
  689.  
  690. DR=B* RMmRR *DELTA
  691. DP=DELTA
  692. ENDIF
  693.  
  694. RR=RR+DR
  695. EPST=EPST+DP
  696.  
  697. IF(MFR1.EQ.3.OR.MFR1.EQ.9) THEN
  698. IF(IFOURB.GE.1) THEN
  699. DO I=1,3
  700. DSIG(I)=DSIG(I)*EP1
  701. ENDDO
  702. DO I=4,6
  703. DSIG(I)=EP1*EP1*DSIG(I)/(6.D0*WORK(2))
  704. ENDDO
  705. ELSE
  706. DSIG(1)=DSIG(1)*EP1
  707. DSIG(2)=DSIG(2)*EP1
  708. DSIG(3)=EP1*EP1*DSIG(3)/(6.D0*WORK(2))
  709. DSIG(4)=EP1*EP1*DSIG(4)/(6.D0*WORK(2))
  710. ENDIF
  711. ENDIF
  712. C mise a jour des contraintes
  713. DO I=1,NCONT
  714. S(I)=S(I)+DSIG(I)
  715. SPHER1(I)=SPHER1(I)+DSPHER1(I)
  716. SPHER2(I)=SPHER2(I)+DSPHER2(I)
  717. SPHER(I)=SPHER1(I)+SPHER2(I)
  718. SX(I)=S(I)-SPHER(I)
  719. ENDDO
  720. if(ifourb.eq.-2.and.(mfr.eq.1.or.mfr.eq.31)) then
  721. s(3)=0.d0
  722. endif
  723.  
  724. yxsxii = 0.D0
  725. if (icow21.gt.0) then
  726. * kich borne trace sigma
  727. ytr = sx(1) + sx(2) + sx(3)
  728. ytr = ytr/3.D0
  729. if (ytr.gt.xlimp) then
  730. yxsxii = ytr - xlimp
  731. else if((ytr + xlimp).lt.0) then
  732. yxsxii = ytr + xlimp
  733. endif
  734. dsigii = dsigt(1) + dsigt(2) + dsigt(3)
  735. if(dsigii.ne.0.D0) then
  736. do jj = 1,3
  737. s(jj) = s(jj) - (dsigt(jj)/dsigii*3.D0*yxsxii)
  738. sx(jj) = sx(jj) - (dsigt(jj)/dsigii*3.D0*yxsxii)
  739. enddo
  740. else
  741. do jj = 1,3
  742. s(jj) = s(jj) - yxsxii
  743. sx(jj) = sx(jj) - yxsxii
  744. enddo
  745. endif
  746. endif
  747.  
  748. SEQ=VONMIS0(SX,NSTRSS,MFR1,IFOURB,EP1,ALFAH)
  749.  
  750. C---------CONTRAINTES PLANES--------------------------------------------
  751.  
  752. IF(IFOURB.EQ.-2) THEN
  753.  
  754. IF(MFR1.EQ.1.OR.MFR1.EQ.31) THEN
  755. F(1)=(2.D0*SX(1)-SX(2)-SX(3))/3.D0
  756. F(2)=(2.D0*SX(2)-SX(1)-SX(3))/3.D0
  757. F(3)=(2.D0*SX(3)-SX(1)-SX(2))/3.D0
  758. DO I=4,NSTRSS
  759. F(I)=SX(I)
  760. ENDDO
  761. DO I=1,3
  762. W1(I)=1.5D0*F(I)/SEQ
  763. ENDDO
  764. DO I=4,NSTRSS
  765. W1(I)=3.D0*F(I)/SEQ
  766. ENDDO
  767.  
  768. ELSE IF(MFR1.EQ.3.OR.MFR1.EQ.9) THEN
  769. AUX=EP1*EP1*EP1*EP1
  770. W1(1)=(2.D0*SX(1)-SX(2))/(2.D0*SEQ*EP1*EP1)
  771. W1(2)=(2.D0*SX(2)-SX(1))/(2.D0*SEQ*EP1*EP1)
  772. W1(3)=18.D0*ALFAH*(2.D0*SX(3)-SX(4))/(SEQ*AUX)
  773. W1(4)=18.D0*ALFAH*(2.D0*SX(4)-SX(3))/(SEQ*AUX)
  774. ENDIF
  775.  
  776. DO I=1,NSTRSS
  777. DEPSP(I)=DEPSP(I)+DELTA*W1(I)
  778. ENDDO
  779. ENDIF
  780.  
  781. C-----------------------------------------------------------------------
  782. C TEST
  783. C CALCUL DE LA NOUVELLE VALEUR DE PHI
  784. C-----------------------------------------------------------------------
  785. IF(INPLAS.EQ.5.OR.INPLAS.EQ.87) THEN
  786. CALL TRACTI(SI,EPST,SIG,EPS,LTRAC,2,IBI)
  787. C* Modele de CHABOCHE (prise en compte ecrouissage)
  788. ELSE IF (INPLAS.EQ.7 .OR. INPLAS.EQ.12) THEN
  789. RMmRR = (RM - R0) * EXP(-B*EPST)
  790. SI = RM - RMmRR
  791. ELSE
  792. SI=RR+SI0
  793. ENDIF
  794. PHI=SEQ-SI
  795.  
  796. PETI=1.D-7
  797. APHI=ABS(PHI)
  798. APHI0=ABS(PHI0)
  799. TEST=max(PETI*APHI0,XZPREC*100.D0*SEQ)
  800. *sg TEST=PETI*APHI0
  801. *sg write(ioimp,*) 'niter,phi,phi0,si,seq,rmmrr,test=',
  802. *sg $ niter,phi,phi0,si,seq,rmmrr,test
  803. IF(NITER.GT.50) THEN
  804. if(itracb.eq.0) then
  805. itracb=1
  806. go to 2222
  807. endif
  808. KERRE=2
  809. GO TO 1000
  810. ENDIF
  811. IF(APHI.LE.TEST) THEN
  812.  
  813. IF(MFR1.EQ.7) THEN
  814. DO I=1,NCONT
  815. S(I)=S(I)/DIV(I)
  816. ENDDO
  817. ENDIF
  818.  
  819. C---------TOUTES FORMULATIONS SAUF CONTRAINTES PLANES-------------------
  820.  
  821. IF(IFOURB.NE.-2) THEN
  822. DO I=1,NCONT
  823. DS(I)=S(I)-SIGB(I)
  824. ENDDO
  825. CALL EPSIG0(DS,DDEPSE,MFR1,IFOURB,YUNG,XNU,WORK,NSTRSS)
  826. DO I=1,NCONT
  827. DEPSE(I)=DEPST(I)+DDEPSE(I)
  828. DEPSP(I)=DEPST(I)-DEPSE(I)
  829. ENDDO
  830. ENDIF
  831.  
  832.  
  833. DO I=1,NSTRSS
  834. SIGF(I)=S(I)
  835. DEFP(I)=DEPSP(I)
  836. ENDDO
  837.  
  838. C---------COQUES AVEC CISAILLEMENT TRANSVERSE---------------------------
  839.  
  840. IF(MFR1.EQ.9) THEN
  841. DEFP(7)=0.D0
  842. DEFP(8)=0.D0
  843. SIGF(7)=SIGB(7)
  844. SIGF(8)=SIGB(8)
  845. ENDIF
  846.  
  847. VARF(1)=EPST
  848. IF(INPLAS.EQ.4.OR.INPLAS.EQ.7.OR.INPLAS.EQ.12) THEN
  849. DO I=1,NSTRSS
  850. VARF(I+1)=SPHER1(I)
  851. ENDDO
  852. IF(INPLAS.EQ.12) THEN
  853. DO I=1,NSTRSS
  854. VARF(NSTRSS+1+I)=SPHER2(I)
  855. ENDDO
  856. ENDIF
  857. ENDIF
  858. IF(INPLAS.EQ.87) THEN
  859. DO I=1,NSTRSS
  860. VARF(1+I)=DEPST(I)
  861. ENDDO
  862. ENDIF
  863. KERRE=0
  864. RETURN
  865.  
  866. ELSE
  867. sx1in=sx(1)
  868. sx2in=sx(2)
  869. s1in=s(1)
  870. s2in=s(2)
  871. GOTO 10
  872. ENDIF
  873. C ENDIF
  874.  
  875. 1000 CONTINUE
  876. RETURN
  877. END
  878.  
  879.  
  880.  
  881.  
  882.  

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