Télécharger cbetoc.eso

Retour à la liste

Numérotation des lignes :

  1. C CBETOC SOURCE BP208322 17/03/01 21:15:06 9325
  2. C BETOCY SOURCE AM 95/12/27 21:15:06 1962
  3. SUBROUTINE CBETOC(wrk52,wrk53,wrk54,WRK2,NCURVT,NCURVC)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C
  7. C MODELE DE MACONNERIE ENDOMMAGEABLE EN CYCLIQUE
  8. C
  9. C=======================================================================
  10. C CETTE ROUTINE EST APPELE DANS ECOUL2
  11. C
  12. C ENTREES:
  13. C -------
  14. C SIG0 = CONTRAINTES AU DEBUT DU PAS D'INTEGRATION
  15. C DSIGT = INCREMENT DE CONT. CALCULE ELASTIQUEMENT A PARTIR DE
  16. C L'INCREMENT DES DEFORMATIONS TOTALES
  17. C VAR0 = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION
  18. C
  19. C XMAT = CARACTERISTIQUES MECANIQUES DU MATERIAU
  20. C
  21. C SORTIES:
  22. C -------
  23. C SIGF = CONTR. A LA FIN DU PAS D'INTEGRATION
  24. C VARF = VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION
  25. C DEFP = INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS
  26. C D'INTEGRATION
  27. C KERRE = INDICE QUI REGIT LES ERREURS
  28. C
  29. C=========================================================================
  30. C VARIABLES NECESSAIRES
  31. C=========================================================================
  32. -INC CCOPTIO
  33. -INC DECHE
  34. C
  35. C Segment pour le Broyden
  36. C
  37. SEGMENT QUASIN
  38. REAL*8 XH0(MN,MN)
  39. REAL*8 WUP(MN,ITM),YUP(MN,ITM)
  40. INTEGER IT
  41. REAL*8 R(MN)
  42. REAL*8 D(MN),DES(MN)
  43. ENDSEGMENT
  44. C Segment des courbes d'ecrouissage
  45. SEGMENT WRK2
  46. REAL*8 TRAC(LTRAC)
  47. ENDSEGMENT
  48.  
  49. DIMENSION SIGT(4),SIGI(4), DSIGI(4), DSIGIDI(4)
  50. C Matrice de compliance (C-1)
  51. DIMENSION CINV(3)
  52. C Variables d'ecrouissage isotrope
  53. DIMENSION XKISO(2)
  54. C Travaux plastiques cycliques et Deformations plastiques equivalentes
  55. C associes au mecanisme de compression de la grande surf.
  56. REAL*8 WORK
  57. DIMENSION EPSI(2),EPSI0(2),EPSII(2)
  58. C Contraintes principales et variables d'ecrouissage cinematique
  59. DIMENSION SIGTP(2), SIGHP(2),SIGHP0(2)
  60. C Cos et Sin de l'angle definissant la premiere direction principale
  61. REAL*8 CPHI, CPHI0, CPHI00, SPHI, SPHI0, SPHI00
  62. C Indicateur du contact
  63. DIMENSION KONTAC(4),KONTA0(4)
  64. C Vecteurs contrainte transitoire
  65. DIMENSION SITPRO(4)
  66. C Jacobien initial
  67. DIMENSION XJ00(3,3)
  68. C Variable phi apparaissant au denominateur (calcul de la normale et de A)
  69. REAL*8 PHI
  70. C Matrices contenant A-1
  71. C AINV --> Inverse de A pour la grande surface
  72. C [ A B 0] A=AINV(1)
  73. C AINVGRANDESURFACE = [-B A 0] B=AINV(2)
  74. C [ 0 0 C] C=AINV(3)
  75. DIMENSION AINV(3)
  76. C Vecteurs normaux aux surface
  77. C XNOR1 --> 1eme mecanisme
  78. C XNOR2 --> 2eme mecanisme
  79. DIMENSION XNOR1(4), XNOR2(4)
  80. C
  81. C Multiplicateurs plastiques 2 mecanismes + 2 surfaces dans GAMBDA
  82. C Valeurs des criteres dans FFF
  83. C Valeurs des limites dans RESIST
  84. C Ordre pour les 3 tableaux:
  85. C 1 --> Traction petite surface direction 1
  86. C 2 --> Traction petite surface direction 2
  87. C 3 --> Compression petite surface direction 1
  88. C 4 --> Compression petite surface direction 2
  89. C 5 --> Traction grande surface
  90. C 6 --> Compression grande surface
  91. DIMENSION GAMBDA(6), FFF(6), RESIST(6)
  92. C Valeur necessaire pour le calcul des residus de la grande surface
  93. DIMENSION XKISO0(2),XKISOI(2)
  94. C
  95. C Separation de l'increment en deux ou trois parties dans le cas du contact
  96. C
  97. REAL*8 SPLITT
  98. REAL*8 XFFFS
  99. C
  100. C Pour differencier les differents cas
  101. C ICAS --> NUMERO DU MULTIPLICATEUR PLASTIQUE A METTRE A JOUR
  102. C IHARD --> NUMERO DE LA VARIABLE D'ECROUISSAGE CINEMATIQUE
  103. C ISGNTC --> Signe indiquant si on est en traction ou compression
  104. C ISGN2 --> Signe indiquant si on prend la plus grande ou la plus
  105. C petite contrainte principale
  106. C NCORNER --> Revient-on sur la pointe ?
  107. INTEGER ICAS, IHARD, ISGNTC, ISGN2
  108. INTEGER ICASB, IHARDB, ISGNTCB, ISGN2B
  109. INTEGER NCORNER
  110. C
  111. C Variable intermediaire valant la resistance de la grande surface
  112. C
  113. DIMENSION FG(2)
  114. C
  115. C Critere de convergence
  116. C
  117. DIMENSION EPSIL(6)
  118. C========================================================================
  119. C Parametres utiles
  120. C========================================================================
  121. PARAMETER (XZER=0.D0,UN=1.D0,DEUX=2.D0,UNDEMI=.5D0)
  122. PARAMETER (UNRADE=0.707106781D0)
  123. PARAMETER (EPSILO=1.D-8,EPSILO2=-1.D-10)
  124. C========================================================================
  125. C
  126. C CALCUL DE DSIGT
  127. C
  128. C calcul de la matrice elastique
  129. C
  130. CMATE = 'ISOTROPE'
  131. KCAS=1
  132. CALL DOHMAS(XMAT,CMATE,IFOUR,4,KCAS,DDHOOK,IRTD)
  133. DO IE1=1,4
  134. DSIGT(IE1)=XZER
  135. DO IE2=1,4
  136. DSIGT(IE1)=DSIGT(IE1)+DDHOOK(IE1,IE2)*DEPST(IE2)
  137. ENDDO
  138. ENDDO
  139. DSIGT(3)=XZER
  140. C=========================================================================
  141. C LECTURE DES PARAMETRES DU MATERIAU
  142. C
  143. C=========================================================================
  144. C Module d'Young YOUN, Poisson XNU, Shear GG
  145. C Ecrouissage cinematique XHH1 ,
  146. YOUN = XMAT(1)
  147. XNU = XMAT(2)
  148. GGG = YOUN/(2*(UN+XNU))
  149. XHH1 = XMAT(5)
  150. CPI = YOUN/(UN-XNU)
  151. C
  152. RESIST(1) = XMAT(6)
  153. RESIST(2) = XMAT(6)
  154. RESIST(3) = XMAT(7)
  155. RESIST(4) = XMAT(7)
  156. RESIST(5) = XMAT(8)
  157. RESIST(6) = XMAT(9)
  158. C Deformation plastique equivalente et travail plastique de ref.
  159. C pour la dissipation cyclique
  160. EPS0 = XMAT(10)
  161. WOR0 = XMAT(11)
  162. DEGRAD = EPS0/WOR0
  163. XLCAT = XMAT(14)
  164. XLCAC = XMAT(15)
  165. C
  166. C
  167. C Evolution des variables d'ecrouissage isotrope
  168. C
  169. C Voila les positions des points d'entree des deux courbes dans TRAC
  170. IPT = 1
  171. IPC = IPT+2*NCURVT
  172. C NCURVT : nombre de point de la courbe de traction
  173. C NCURVC : nombre de point de la courbe de compression
  174. C===========================================================
  175. C Fin lecture des caracteristiques
  176. C On passe aux contraintes et variables d'etat
  177. C===========================================================
  178. C
  179. C CONTRAINTES ELASTIQUES
  180. C
  181. SIGI(1) = SIG0(1)
  182. SIGI(2) = SIG0(2)
  183. SIGI(4) = SIG0(4)
  184. C DELTA SIGMA TRIAL
  185. DSIGI(1) = DSIGT(1)
  186. DSIGI(2) = DSIGT(2)
  187. DSIGI(4) = DSIGT(4)
  188. C
  189. C ECROUISSAGE CINEMATIQUE
  190. C
  191. SIGHP0(1) = VAR0(1)
  192. SIGHP0(2) = VAR0(2)
  193. C
  194. C ECROUISSAGE ISOTROPE
  195. C
  196. EPSI0(1) = VAR0(3)
  197. EPSI0(2) = VAR0(4)
  198. C
  199. CPHI00 = VAR0(5) + 1.D0
  200. CPHI0 = CPHI00
  201. SPHI00 = VAR0(6)
  202. SPHI0 = SPHI00
  203. C
  204. KONTA0(1) = nint(VAR0( 7))
  205. KONTA0(2) = nint(VAR0( 8))
  206. KONTA0(3) = nint(VAR0( 9))
  207. KONTA0(4) = nint(VAR0(10))
  208. C
  209. C Variables de contact
  210. C
  211. SPLITT = 0.D0
  212. NCON = 0
  213. IDICHO = 0
  214. NDICHO = 0
  215. NPASS = 0
  216. DSIGIDI(1) = XZER
  217. DSIGIDI(2) = XZER
  218. DSIGIDI(4) = XZER
  219. C===============================================
  220. C Fin de la lecture des contraintes et des variables d'etat
  221. C================================================
  222. C
  223. C Premier calcul des residus puis DRIVER
  224. C================================================
  225. C
  226. C Entree quand on revient des routines, dernier test avant de finir
  227. C
  228. 10 CONTINUE
  229. SIGT(1) = SIGI(1) + DSIGI(1)
  230. SIGT(2) = SIGI(2) + DSIGI(2)
  231. SIGT(4) = SIGI(4) + DSIGI(4)
  232. CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  233. EPSI(1) = EPSI0(1)
  234. EPSI(2) = EPSI0(2)
  235. CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  236. &XKISO(1),DUMM,KERRE)
  237. CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  238. &XKISO(2),DUMM,KERRE)
  239. SIGHP(1) = SIGHP0(1)
  240. SIGHP(2) = SIGHP0(2)
  241. NPASS2 = 0
  242. KONTAC(1) = KONTA0(1)
  243. KONTAC(2) = KONTA0(2)
  244. KONTAC(3) = KONTA0(3)
  245. KONTAC(4) = KONTA0(4)
  246. C
  247. C Calcul des residus initiaux
  248. C
  249. NMEC = 0
  250. FFF(1) = XZER
  251. FFF(2) = XZER
  252. FFF(3) = XZER
  253. FFF(4) = XZER
  254. FFF(5) = XZER
  255. FFF(6) = XZER
  256. FINT1 = XZER
  257. FINT2 = XZER
  258. GAMBDA(1) = XZER
  259. GAMBDA(2) = XZER
  260. GAMBDA(3) = XZER
  261. GAMBDA(4) = XZER
  262. GAMBDA(5) = XZER
  263. GAMBDA(6) = XZER
  264. ICAS = 0
  265. ICASB = 0
  266. C
  267. C Critere de convergence
  268. C
  269. EPSIL(1) = ABS(RESIST(1)*EPSILO)
  270. EPSIL(2) = ABS(RESIST(2)*EPSILO)
  271. EPSIL(3) = ABS(RESIST(3)*EPSILO)
  272. EPSIL(4) = ABS(RESIST(4)*EPSILO)
  273. EPSIL(5) = ABS(RESIST(5)*EPSILO)
  274. EPSIL(6) = ABS(RESIST(6)*EPSILO)
  275. C
  276. C
  277. IF (KONTAC(1).EQ.0) THEN
  278. CALL CRITPE (SIGTP(1), SIGHP0(1), RESIST(1), 1, FFF(1))
  279. FINT1 = 0.
  280. IF (FFF(1).GE.EPSIL(1)) THEN
  281. NMEC = NMEC + 1
  282. IF (NMEC.EQ.1) THEN
  283. ICAS = 1
  284. ISGNTC = 1
  285. IHARD = 1
  286. ELSE
  287. ICASB = 1
  288. ISGNTCB = 1
  289. IHARDB = 1
  290. ENDIF
  291. ENDIF
  292. ELSE
  293. FG(1) = XKISO(1)*RESIST(5)
  294. CALL CRITPE (SIGTP(1), XZER, FG(1), 1, FINT1)
  295. ENDIF
  296. C
  297. IF (KONTAC(2).EQ.0) THEN
  298. CALL CRITPE (SIGTP(2), SIGHP0(2), RESIST(2), 1, FFF(2))
  299. FINT2 = 0.
  300. IF (FFF(2).GE.EPSIL(2)) THEN
  301. NMEC = NMEC + 1
  302. IF (NMEC.EQ.1) THEN
  303. ICAS = 2
  304. ISGNTC = 1
  305. IHARD = 2
  306. ELSE
  307. ICASB = 2
  308. ISGNTCB = 1
  309. IHARDB = 2
  310. ENDIF
  311. ENDIF
  312. ELSE
  313. FG(1) = XKISO(1)*RESIST(5)
  314. CALL CRITPE (SIGTP(2), XZER, FG(1), 1, FINT2)
  315. ENDIF
  316. C
  317. IF ((FINT1.GE.EPSIL(5)).OR.(FINT2.GE.EPSIL(5))) THEN
  318. NMEC = NMEC + 1
  319. IF (FINT1.GE.FINT2) THEN
  320. FFF(5) = FINT1
  321. IF (NMEC.EQ.1) THEN
  322. IHARD = 1
  323. ICAS = 5
  324. ISGNTC = 1
  325. ELSE
  326. IHARDB = 1
  327. ICASB = 5
  328. ISGNTCB = 1
  329. ENDIF
  330. ELSE
  331. FFF(5) = FINT2
  332. IF (NMEC.EQ.1) THEN
  333. IHARD = 2
  334. ICAS = 5
  335. ISGNTC = 1
  336. ELSE
  337. IHARDB = 2
  338. ICASB = 5
  339. ISGNTCB = 1
  340. ENDIF
  341. ENDIF
  342. ENDIF
  343. C
  344. IF (KONTAC(3).EQ.0) THEN
  345. CALL CRITPE (SIGTP(1), SIGHP0(1), RESIST(3), -1, FFF(3))
  346. FINT1 = 0.
  347. IF (FFF(3).GE.EPSIL(3)) THEN
  348. NMEC = NMEC + 1
  349. IF (NMEC.EQ.1) THEN
  350. ICAS = 3
  351. ISGNTC = -1
  352. IHARD = 1
  353. ELSE
  354. ICASB = 3
  355. ISGNTCB = -1
  356. IHARDB = 1
  357. ENDIF
  358. ENDIF
  359. ELSE
  360. FG(1) = XKISO(2)*RESIST(6)
  361. CALL CRITPE (SIGTP(1), XZER, FG(1), -1, FINT1)
  362. ENDIF
  363. C
  364. IF (KONTAC(4).EQ.0) THEN
  365. CALL CRITPE (SIGTP(2), SIGHP0(2), RESIST(4), -1, FFF(4))
  366. FINT2 = 0.
  367. IF (FFF(4).GE.EPSIL(4)) THEN
  368. NMEC = NMEC + 1
  369. IF (NMEC.EQ.1) THEN
  370. ICAS = 4
  371. ISGNTC = -1
  372. IHARD = 2
  373. ELSE
  374. ICASB = 4
  375. ISGNTCB = -1
  376. IHARDB = 2
  377. ENDIF
  378. ENDIF
  379. ELSE
  380. FG(1) = XKISO(2)*RESIST(6)
  381. CALL CRITPE (SIGTP(2), XZER, FG(1), -1, FINT2)
  382. ENDIF
  383. C
  384. IF ((FINT1.GE.EPSIL(6)).OR.(FINT2.GE.EPSIL(6))) THEN
  385. NMEC = NMEC + 1
  386. IF (FINT1.GE.FINT2) THEN
  387. FFF(6) = FINT1
  388. IF (NMEC.EQ.1) THEN
  389. IHARD = 1
  390. ICAS = 6
  391. ISGNTC = -1
  392. ELSE
  393. IHARDB = 1
  394. ICASB = 6
  395. ISGNTCB = -1
  396. ENDIF
  397. ELSE
  398. FFF(6) = FINT2
  399. IF (NMEC.EQ.1) THEN
  400. IHARD = 2
  401. ICAS = 6
  402. ISGNTC = -1
  403. ELSE
  404. IHARDB = 2
  405. ICASB = 6
  406. ISGNTCB = -1
  407. ENDIF
  408. ENDIF
  409. ENDIF
  410. C
  411. C
  412. C Le tableau FFF contient les residus
  413. C
  414. C================================================
  415. C DRIVER
  416. C================================================
  417. IF (NMEC.EQ.0) GOTO 9999
  418. C
  419. IF (NMEC.EQ.1) GOTO 1000
  420. C
  421. IF (NMEC.EQ.2) GOTO 4000
  422. C
  423. GOTO 9999
  424. C==================================================
  425. C CAS 1:
  426. C Un seul mecanisme est active
  427. C==================================================
  428. 1000 CONTINUE
  429. C
  430. CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  431. C
  432. C Mis a jour de isgn2
  433. C
  434. IF (IHARD.EQ.1) THEN
  435. IF (SIGTP(1).GE.SIGTP(2)) THEN
  436. ISGN2 = 1
  437. ELSE
  438. ISGN2 = -1
  439. ENDIF
  440. HARDC = 2
  441. ELSE
  442. IF (IHARD.EQ.2) THEN
  443. IF (SIGTP(2).GE.SIGTP(1)) THEN
  444. ISGN2 = 1
  445. ELSE
  446. ISGN2 = -1
  447. ENDIF
  448. ENDIF
  449. HARDC = 1
  450. ENDIF
  451. C
  452. IF (IHARD.EQ.1) THEN
  453. IHARDC = 2
  454. ELSE
  455. IHARDC = 1
  456. ENDIF
  457. C
  458. NCORNER = 0
  459. C
  460. 1010 CONTINUE
  461. C
  462. C Definition du segment
  463. C
  464. ITM = 30
  465. MN = 1
  466. SEGINI,QUASIN
  467. IT = -1
  468. C
  469. C Calcul de xhh2 et xkiso
  470. C
  471. IF (ICAS.GE.5) THEN
  472. IF (ICAS.EQ.5) THEN
  473. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  474. &XKISO(1),XHH2,KERRE)
  475. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  476. &XKISO(2),DUMM,KERRE)
  477. ELSE
  478. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  479. &XKISO(1),DUMM,KERRE)
  480. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  481. &XKISO(2),XHH2,KERRE)
  482. ENDIF
  483. EPSI(1) = EPSI0(1)
  484. XKISO0(1) = XKISO(1)
  485. EPSI(2) = EPSI0(2)
  486. XKISO0(2) = XKISO(2)
  487. XHH2I = XHH2
  488. EPSII(1) = EPSI0(1)
  489. XKISOI(1) = XKISO(1)
  490. EPSII(2) = EPSI0(2)
  491. XKISOI(2) = XKISO(2)
  492. ENDIF
  493. C
  494. DO 1011,IE1=1,6
  495. FFF(IE1) = XZER
  496. 1011 CONTINUE
  497. C
  498. IF (ICAS.LE.4) THEN
  499. CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD),RESIST(ICAS),
  500. & ISGNTC,FFF(ICAS))
  501. ELSE
  502. FG(1) = XKISOI(ICAS-4)*RESIST(ICAS)
  503. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FINT1)
  504. CALL CRITPE (SIGTP(IHARDC),XZER,FG(1),ISGNTC,FINT2)
  505. FFF(ICAS) = MAX(FINT1,FINT2)
  506. ENDIF
  507. C
  508. C Calcul de la normale et du jacobien
  509. C
  510. IF (ICAS.LE.4) THEN
  511. CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1)
  512. XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU)-XHH1
  513. ELSE
  514. CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,2,XNOR1)
  515. XJ00(1,1) = -XXCCYY(XNOR1,XNOR1,YOUN,XNU)
  516. & -ISGNTC*RESIST(ICAS)*XHH2
  517. ENDIF
  518. C
  519. R(1) = + FFF(ICAS)
  520. GAMBDA(1)=XZER
  521. GAMBDA(2)=XZER
  522. GAMBDA(3)=XZER
  523. GAMBDA(4)=XZER
  524. GAMBDA(5)=XZER
  525. GAMBDA(6)=XZER
  526. C
  527. XJ0INV = UN/XJ00(1,1)
  528. C
  529. CALL ZERO(D,1,MN)
  530. XH0(1,1) = XJ0INV
  531. C
  532. C On rentre dans les iterations internes
  533. C
  534. DO I=0,ITM
  535. C
  536. C Appel de Broyden
  537. C
  538. CALL BROYDE (QUASIN)
  539. C
  540. GAMBDA(ICAS) = D(1)
  541. C
  542. C Calcul du phi et des termes de la matrice A et A-1
  543. C
  544. SITPRO(1) = SIGI(1) + DSIGI(1)
  545. & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI
  546. & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI
  547. SITPRO(2) = SIGI(2) + DSIGI(2)
  548. & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI
  549. & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI
  550. SITPRO(4) = SIGI(4) + DSIGI(4)
  551. C
  552. C Mis a jour des variables d'ecrouissage
  553. C
  554. SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3))
  555. SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4))
  556. EPSI(1) = EPSI0(1) + GAMBDA(5)
  557. IF (ICAS.LE.4) THEN
  558. WORK = GAMBDA(ICAS)*RESIST(ICAS)*ISGNTC
  559. ELSE
  560. WORK = XZER
  561. ENDIF
  562. EPSI(2) = EPSI0(2) + GAMBDA(6) + DEGRAD*WORK
  563. C
  564. IF (ICAS.LE.4) THEN
  565. CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  566. &XKISO(1),DUMM,KERRE)
  567. CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  568. &XKISO(2),DUMM,KERRE)
  569. ELSE
  570. IF (ICAS.EQ.5) THEN
  571. CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  572. &XKISO(1),XHH2,KERRE)
  573. CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  574. &XKISO(2),DUMM,KERRE)
  575. ELSE
  576. CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  577. &XKISO(1),DUMM,KERRE)
  578. CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  579. &XKISO(2),XHH2,KERRE)
  580. ENDIF
  581. ENDIF
  582. C
  583. C Calcul des phi
  584. C
  585. IF (ICAS.LE.4) THEN
  586. PHI = ISGNTC*(-UNDEMI*(SITPRO(1) + SITPRO(2)) + SIGHP(IHARD)
  587. & + RESIST(ICAS))
  588. ELSE
  589. PHI = ISGNTC*(-UNDEMI*(SITPRO(1)+SITPRO(2))
  590. & +(XKISOI(ICAS - 4)+(EPSI(ICAS-4) - EPSII(ICAS-4))*XHH2I)
  591. & *RESIST(ICAS))
  592. ENDIF
  593. C
  594. C Calcul de AINV
  595. C
  596. SOMLAM = GAMBDA(1) + GAMBDA(2) + GAMBDA(3) + GAMBDA(4)
  597. & + GAMBDA(5) + GAMBDA(6)
  598. AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM)
  599. AINV(2) = GGG*SOMLAM/(DEUX*PHI + DEUX*GGG*SOMLAM)
  600. AINV(3) = PHI/(PHI + (GGG*SOMLAM))
  601. C
  602. C Calcul des contraintes a l'aide de AINV
  603. C
  604. SIGT(1) = AINV(1)*SITPRO(1) + AINV(2)*SITPRO(2)
  605. SIGT(2) = AINV(2)*SITPRO(1) + AINV(1)*SITPRO(2)
  606. SIGT(4) = AINV(3)*SITPRO(4)
  607. C
  608. C Nouvelles contraintes principales
  609. C
  610. CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  611. C
  612. C
  613. IF (ICAS.LE.4) THEN
  614. CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD),RESIST(ICAS),
  615. & ISGNTC,FFF(ICAS))
  616. R(1)= + FFF(ICAS)
  617. ELSE
  618. FG(1) = (XKISOI(ICAS-4)+(EPSI(ICAS-4)-EPSII(ICAS-4))*XHH2I)
  619. & *RESIST(ICAS)
  620. C
  621. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FINT1)
  622. CALL CRITPE (SIGTP(IHARDC),XZER,FG(1),ISGNTC,FINT2)
  623. FFF(ICAS) = MAX (FINT1,FINT2)
  624. C
  625. R(1) = + FFF(ICAS)
  626. & - ISGNTC*RESIST(ICAS)
  627. & * (XKISO(ICAS-4) - XKISOI(ICAS-4)
  628. & -(EPSI(ICAS-4) - EPSII(ICAS-4))*XHH2I)
  629. IF (ABS(EPSI(ICAS-4) - EPSII(ICAS-4)).LT.EPSILO2) THEN
  630. XHH2I=XHH2
  631. ELSE
  632. XHH2I = (XKISO(ICAS-4) - XKISOI(ICAS-4))/
  633. & (EPSI(ICAS-4) - EPSII(ICAS-4))
  634. ENDIF
  635. XKISOI(ICAS-4) = XKISO(ICAS-4)
  636. EPSII(ICAS-4) = EPSI(ICAS-4)
  637. ENDIF
  638. C
  639. C Test de convergence
  640. C
  641. C IF (ABS(FFF(ICAS)).LT.EPSIL(ICAS)) GOTO 1020
  642. IF ((ABS(FFF(ICAS)).LT.EPSIL(ICAS))
  643. & .AND.(ABS(R(1)).LT.EPSIL(ICAS))) GOTO 1020
  644. ENDDO
  645. C
  646. C Pas de convergence
  647. C
  648. SEGSUP,QUASIN
  649. GOTO 6000
  650. C
  651. 1020 CONTINUE
  652. SEGSUP,QUASIN
  653. C
  654. IF (GAMBDA(ICAS).LT.EPSILO2) THEN
  655. WRITE (IOIMP,*)'BETOCY: Multiplicateurs plastiques < 0'
  656. KERRE = 2
  657. RETURN
  658. ELSE
  659. CONTINUE
  660. ENDIF
  661. C
  662. C On verifie qu'on ne viole pas les autres criteres
  663. C
  664. IF (IHARD.EQ.2) THEN
  665. IHARDC=1
  666. ELSE
  667. IHARDC=2
  668. ENDIF
  669. C
  670. IF (ICAS.LE.2) THEN
  671. FG(1) = XKISO(1)*RESIST(5)
  672. FG(2) = XKISO(2)*RESIST(6)
  673. ELSE
  674. IF (ICAS.LE.4) THEN
  675. FG(1) = XKISO(2)*RESIST(6)
  676. FG(2) = XKISO(1)*RESIST(5)
  677. ELSE
  678. IF (ICAS.EQ.5) THEN
  679. FG(1) = XKISO(1)*RESIST(5)
  680. FG(2) = XKISO(2)*RESIST(6)
  681. ELSE
  682. FG(1) = XKISO(2)*RESIST(6)
  683. FG(2) = XKISO(1)*RESIST(5)
  684. ENDIF
  685. ENDIF
  686. ENDIF
  687. C
  688. C Test GS
  689. C
  690. IF (ICAS.GE.5) THEN
  691. C Regles de suivi si on est sur la grande surface
  692. C 1- Direction de l'ecoulement
  693. SIGHP(IHARD) = FG(1) -RESIST(2*ICAS-10+IHARD)
  694. C 2- Direction perpendiculaire a l'ecoulement
  695. C (si on se trouve dans le coin)
  696. XLIMIT = FG(1) -RESIST(2*ICAS-10+IHARDC)
  697. IF (ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN
  698. SIGHP(IHARDC) = XLIMIT
  699. KONTAC(2*ICAS-10+IHARDC)=1
  700. ENDIF
  701. ENDIF
  702. C
  703. C
  704. C On teste les autres mecanismes
  705. C
  706. C Test des contacts lateraux
  707. C Meme signe signtc
  708. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN
  709. ICASB = ICAS + 1
  710. ELSE
  711. IF ((ICAS.EQ.2).OR.(ICAS.EQ.4)) THEN
  712. ICASB = ICAS -1
  713. ELSE
  714. ICASB = 2*ICAS-10+IHARDC
  715. ENDIF
  716. ENDIF
  717. IF (KONTAC(ICASB).EQ.0) THEN
  718. CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC), RESIST(ICASB),
  719. &ISGNTC,XFFFS)
  720. IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  721. &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  722. IHARDB = IHARDC
  723. ISGNTCB = ISGNTC
  724. GOTO 1100
  725. ELSE
  726. IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  727. &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  728. KONTAC(ICASB)=1
  729. ENDIF
  730. ENDIF
  731. ELSE
  732. CALL CRITPE(SIGTP(IHARDC), XZER, FG(1), ISGNTC,XFFFS)
  733. IF (ICASB.LE.2) THEN
  734. ICASB = 5
  735. ELSE
  736. ICASB = 6
  737. ENDIF
  738. IF (XFFFS.GE.EPSIL(ICASB)) THEN
  739. IHARDB = IHARDC
  740. ISGNTCB = ISGNTC
  741. GOTO 1100
  742. ENDIF
  743. ENDIF
  744. C Autre signe signtc
  745. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN
  746. ICASB = ICAS + 1
  747. ELSE
  748. IF ((ICAS.EQ.2).OR.(ICAS.EQ.4)) THEN
  749. ICASB = ICAS - 1
  750. ELSE
  751. ICASB = 2*ICAS-10+IHARDC
  752. ENDIF
  753. ENDIF
  754. IF (ICASB.LE.2) THEN
  755. ICASB = ICASB +2
  756. ELSE
  757. ICASB = ICASB -2
  758. ENDIF
  759. IF (KONTAC(ICASB).EQ.0) THEN
  760. CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC), RESIST(ICASB),
  761. &-ISGNTC,XFFFS)
  762. IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  763. &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  764. IHARDB = IHARDC
  765. ISGNTCB = -ISGNTC
  766. GOTO 1100
  767. ELSE
  768. IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  769. &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  770. KONTAC(ICASB)=1
  771. ENDIF
  772. ENDIF
  773. ELSE
  774. CALL CRITPE(SIGTP(IHARDC), XZER, FG(2), -ISGNTC,XFFFS)
  775. IF (ICASB.LE.2) THEN
  776. ICASB = 5
  777. ELSE
  778. ICASB = 6
  779. ENDIF
  780. IF (XFFFS.GE.EPSIL(ICASB)) THEN
  781. IHARDB = IHARDC
  782. ISGNTCB = -ISGNTC
  783. GOTO 1100
  784. ENDIF
  785. ENDIF
  786. C Test du contact frontal
  787. IF (ICAS.LE.4) THEN
  788. CALL CRITPE(SIGTP(IHARD), XZER, FG(1), ISGNTC,XFFFS)
  789. IF (((XFFFS.GE.EPSIL(5)).AND.(ICAS.LE.2)).OR.
  790. &((XFFFS.GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN
  791. GOTO 1040
  792. ELSE
  793. IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICAS.LE.2)).OR.
  794. &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICAS.GE.3))) THEN
  795. KONTAC(ICAS) = 1
  796. ENDIF
  797. ENDIF
  798. ENDIF
  799. C
  800. C Il faut faire suivre la petite surface si la grande se retrecit trop vite
  801. C
  802. IF (ICAS.LE.4) THEN
  803. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN
  804. ICASB = ICAS +1
  805. ELSE
  806. ICASB = ICAS -1
  807. ENDIF
  808. XLIMIT = FG(1) -RESIST(ICASB)
  809. IF (ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN
  810. SIGHP(IHARDC) = XLIMIT
  811. KONTAC(ICASB) = 1
  812. ENDIF
  813. IF (ICASB.LE.2) THEN
  814. ICASB = ICASB +2
  815. ELSE
  816. ICASB = ICASB -2
  817. ENDIF
  818. XLIMIT = FG(2) -RESIST(ICASB)
  819. IF (-ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN
  820. SIGHP(IHARDC) = XLIMIT
  821. KONTAC(ICASB) = 1
  822. ENDIF
  823. ENDIF
  824. C
  825. C Mis a jour des indicateurs de contact
  826. C
  827. IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT.
  828. &(RESIST(1)-RESIST(3))) THEN
  829. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0
  830. IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0
  831. ELSE
  832. KONTAC(1) = 1
  833. KONTAC(2) = 1
  834. KONTAC(3) = 1
  835. KONTAC(4) = 1
  836. ENDIF
  837. C
  838. ICASB = ICAS
  839. GOTO 9999
  840. C
  841. C Cas ou on trouve le contact frontal
  842. C
  843. 1040 CONTINUE
  844. SIGHP(1) = SIGHP0(1)
  845. SIGHP(2) = SIGHP0(2)
  846. SIGT(1) = SIGI(1) + DSIGI(1)
  847. SIGT(2) = SIGI(2) + DSIGI(2)
  848. SIGT(4) = SIGI(4) + DSIGI(4)
  849. GOTO 3000
  850. C
  851. C Cas ou on viole un critere lateral
  852. C
  853. 1100 CONTINUE
  854. SIGHP(1) = SIGHP0(1)
  855. SIGHP(2) = SIGHP0(2)
  856. SIGT(1) = SIGI(1) + DSIGI(1)
  857. SIGT(2) = SIGI(2) + DSIGI(2)
  858. SIGT(4) = SIGI(4) + DSIGI(4)
  859. IF (ICAS.EQ.ICASB) THEN
  860. IF (ICAS.GE.5) THEN
  861. GOTO 1000
  862. ELSE
  863. KERRE = 2
  864. RETURN
  865. ENDIF
  866. ELSE
  867. GOTO 4000
  868. ENDIF
  869. C================================================================
  870. C CAS 2
  871. C Un seul mecanisme de chaque surface
  872. C mais entree en contact des 2 mecanismes
  873. C================================================================
  874. 3000 CONTINUE
  875. C
  876. CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  877. C
  878. C
  879. C Calcul de la normale a l'estimation elastique et du jacobien initial
  880. C
  881. IF (IHARD.EQ.1) THEN
  882. IF (SIGTP(1).GE.SIGTP(2)) THEN
  883. ISGN2 = 1
  884. ELSE
  885. ISGN2 = -1
  886. ENDIF
  887. ELSE
  888. IF (IHARD.EQ.2) THEN
  889. IF (SIGTP(2).GE.SIGTP(1)) THEN
  890. ISGN2 = 1
  891. ELSE
  892. ISGN2 = -1
  893. ENDIF
  894. ENDIF
  895. ENDIF
  896. C
  897. 3010 CONTINUE
  898. C
  899. C Definition du segment
  900. C
  901. ITM = 30
  902. MN = 2
  903. SEGINI,QUASIN
  904. IT = -1
  905. CALL ZERO(D,1,MN)
  906. C
  907. C Calcul de xhh2 et xkiso
  908. C
  909. IF (ICAS.LE.2) THEN
  910. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  911. &XKISO(1),XHH2,KERRE)
  912. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  913. &XKISO(2),DUMM,KERRE)
  914. ELSE
  915. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  916. &XKISO(1),DUMM,KERRE)
  917. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  918. &XKISO(2),XHH2,KERRE)
  919. ENDIF
  920. EPSI(1) = EPSI0(1)
  921. XKISO0(1) = XKISO(1)
  922. EPSI(2) = EPSI0(2)
  923. XKISO0(2) = XKISO(2)
  924. XHH2I = XHH2
  925. EPSII(1) = EPSI0(1)
  926. XKISOI(1) = XKISO(1)
  927. EPSII(2) = EPSI0(2)
  928. XKISOI(2) = XKISO(2)
  929. C
  930. DO 3011,IE1=1,6
  931. FFF(IE1) = XZER
  932. 3011 CONTINUE
  933. C
  934. IF (ISGNTC.GT.0) THEN
  935. FG(1) = XKISO(1)*RESIST(5)
  936. ELSE
  937. FG(1) = XKISO(2)*RESIST(6)
  938. ENDIF
  939. CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD)
  940. & ,RESIST(ICAS),ISGNTC,FFF(ICAS))
  941. CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC, XFFFS)
  942. C
  943. CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1)
  944. XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU)-XHH1
  945. XJ00(2,2) = -XXYY(XNOR1,DSIGI)
  946. XJ00(1,2) = -XXYY(XNOR1,DSIGI)
  947. XJ00(2,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU)
  948. IF (ISGNTC.LT.0) THEN
  949. XJ00(2,1)=XJ00(2,1)+RESIST(6)*XHH2*DEGRAD*ISGNTC*RESIST(ICAS)
  950. ENDIF
  951. R(1) = FFF(ICAS)
  952. R(2) = XFFFS
  953. GAMBDA(1)=XZER
  954. GAMBDA(2)=XZER
  955. GAMBDA(3)=XZER
  956. GAMBDA(4)=XZER
  957. GAMBDA(5)=XZER
  958. GAMBDA(6)=XZER
  959. C
  960. C Inverse du jacobien
  961. C
  962. XH0(1,1) = XJ00(1,1)
  963. XH0(1,2) = XJ00(1,2)
  964. XH0(2,1) = XJ00(2,1)
  965. XH0(2,2) = XJ00(2,2)
  966. CALL INVALM (XH0, MN , MN , IRD, 1.D-12)
  967. IF (IRD.NE.0) THEN
  968. SEGSUP,QUASIN
  969. GOTO 6000
  970. ENDIF
  971. C
  972. C On rentre dans les iterations internes
  973. C
  974. DO I=0,ITM
  975. C
  976. C Appel de Broyden
  977. C
  978. CALL BROYDE (QUASIN)
  979. C
  980. GAMBDA(ICAS) = D(1)
  981. SPLITT = D(2)
  982. C
  983. C Calcul du phi et des termes de la matrice A et A-1
  984. C
  985. SITPRO(1) = SIGI(1) + ((UN-SPLITT)*DSIGI(1))
  986. & - UNDEMI*(GAMBDA(1) + GAMBDA(2))*CPI
  987. & + UNDEMI*(GAMBDA(3) + GAMBDA(4))*CPI
  988. SITPRO(2) = SIGI(2) + ((UN-SPLITT)*DSIGI(2))
  989. & - UNDEMI*(GAMBDA(1) + GAMBDA(2))*CPI
  990. & + UNDEMI*(GAMBDA(3) + GAMBDA(4))*CPI
  991. SITPRO(4) = SIGI(4) + (UN-SPLITT)*DSIGI(4)
  992. C
  993. SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3))
  994. SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4))
  995. EPSI(1) = EPSI0(1)
  996. WORK = GAMBDA(ICAS)*ISGNTC*RESIST(ICAS)
  997. EPSI(2) = EPSI0(2) + DEGRAD*WORK
  998. CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  999. &XKISO(2),XHH2,KERRE)
  1000. C
  1001. PHI = ISGNTC*(-UNDEMI*(SITPRO(1)+SITPRO(2))+SIGHP(IHARD)
  1002. & + RESIST(ICAS))
  1003. C
  1004. C
  1005. SOMLAM = GAMBDA(1) + GAMBDA(2) + GAMBDA(3) + GAMBDA(4)
  1006. AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM)
  1007. AINV(2) = GGG*SOMLAM/(DEUX*PHI + DEUX*GGG*SOMLAM)
  1008. AINV(3) = PHI/(PHI + GGG*SOMLAM)
  1009. C
  1010. C Calcul des contraintes a l'aide de AINV
  1011. C
  1012. SIGT(1) = AINV(1)*SITPRO(1)+AINV(2)*SITPRO(2)
  1013. SIGT(2) = AINV(2)*SITPRO(1)+AINV(1)*SITPRO(2)
  1014. SIGT(4) = AINV(3)*SITPRO(4)
  1015. C
  1016. C Nouvelles contraintes principales
  1017. C
  1018. CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  1019. C
  1020. NMEC = 0
  1021. C
  1022. IF (ISGNTC.GT.0) THEN
  1023. FG(1) = XKISO(1)*RESIST(5)
  1024. ELSE
  1025. FG(1) = (XKISOI(2) + XHH2I*(EPSI(2)-EPSII(2)))*RESIST(6)
  1026. ENDIF
  1027. CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD)
  1028. & ,RESIST(ICAS),ISGNTC,FFF(ICAS))
  1029. R(1) = + FFF(ICAS)
  1030. IF (ABS(FFF(ICAS)).GE.EPSIL(ICAS)) THEN
  1031. NMEC = NMEC + 1
  1032. ENDIF
  1033. CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC, XFFFS)
  1034. R(2) = XFFFS
  1035. IF (ICAS.GE.3) THEN
  1036. R(2) = R(2) + RESIST(6)*(XKISO(2) - XKISOI(2)
  1037. & - (EPSI(2) - EPSII(2))*XHH2I)
  1038. IF (ABS(EPSI(2) - EPSII(2)).LT.EPSILO2) THEN
  1039. XHH2I=XHH2
  1040. ELSE
  1041. XHH2I = (XKISO(2) - XKISOI(2))/
  1042. & (EPSI(2) - EPSII(2))
  1043. ENDIF
  1044. EPSII(2) = EPSI(2)
  1045. XKISOI(2) = XKISO(2)
  1046. ENDIF
  1047. IF (((ABS(XFFFS).GE.EPSIL(5)).AND.(ICAS.LE.2)).OR.
  1048. &((ABS(XFFFS).GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN
  1049. NMEC = NMEC + 1
  1050. ENDIF
  1051. C
  1052. C Test de convergence
  1053. C
  1054. IF (NMEC.EQ.0) GOTO 3020
  1055. ENDDO
  1056. C
  1057. C Pas de convergence
  1058. C
  1059. SEGSUP,QUASIN
  1060. GOTO 6000
  1061. C
  1062. 3020 CONTINUE
  1063. C
  1064. C On verifie que la convergence ne s'est pas faite sur un point debile
  1065. C
  1066. SEGSUP,QUASIN
  1067. IF (((SPLITT-1.).LE.EPSILO).AND.(SPLITT.GE.(-1.*EPSILO))) THEN
  1068. C
  1069. IF (IHARD.EQ.2) THEN
  1070. IHARDC=1
  1071. ELSE
  1072. IHARDC=2
  1073. ENDIF
  1074. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) ICASC = ICAS + 1
  1075. IF ((ICAS.EQ.2).OR.(ICAS.EQ.4)) ICASC = ICAS - 1
  1076. C
  1077. IF (ICAS.LE.2) THEN
  1078. FG(1) = XKISO(1)*RESIST(5)
  1079. FG(2) = XKISO(2)*RESIST(6)
  1080. ELSE
  1081. FG(1) = XKISO(2)*RESIST(6)
  1082. FG(2) = XKISO(1)*RESIST(5)
  1083. ENDIF
  1084. C
  1085. C Test des contacts lateraux
  1086. C Meme signe signtc
  1087. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN
  1088. ICASB = ICAS + 1
  1089. ELSE
  1090. ICASB = ICAS -1
  1091. ENDIF
  1092. IF (KONTAC(ICASB).EQ.0) THEN
  1093. CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC),
  1094. & RESIST(ICASB), ISGNTC,XFFFS)
  1095. IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  1096. &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  1097. IHARDB = IHARDC
  1098. ISGNTCB = ISGNTC
  1099. GOTO 3100
  1100. ELSE
  1101. IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  1102. &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  1103. KONTAC(ICASB)=1
  1104. ENDIF
  1105. ENDIF
  1106. ELSE
  1107. CALL CRITPE(SIGTP(IHARDC), XZER, FG(1), ISGNTC,XFFFS)
  1108. IF (ICASB.LE.2) THEN
  1109. ICASB = 5
  1110. ELSE
  1111. ICASB = 6
  1112. ENDIF
  1113. IF (XFFFS.GE.EPSIL(ICASB)) THEN
  1114. IHARDB = IHARDC
  1115. ISGNTCB = -ISGNTC
  1116. GOTO 3100
  1117. ENDIF
  1118. ENDIF
  1119. C Autre signe signtc
  1120. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN
  1121. ICASB = ICAS + 1
  1122. ELSE
  1123. ICASB = ICAS -1
  1124. ENDIF
  1125. IF (ICASB.LE.2) THEN
  1126. ICASB = ICASB +2
  1127. ELSE
  1128. ICASB = ICASB -2
  1129. ENDIF
  1130. IF (KONTAC(ICASB).EQ.0) THEN
  1131. CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC),RESIST(ICASB),
  1132. & -ISGNTC,XFFFS)
  1133. IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  1134. &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  1135. IHARDB = IHARDC
  1136. ISGNTCB = ISGNTC
  1137. GOTO 3100
  1138. ELSE
  1139. IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  1140. &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  1141. KONTAC(ICASB)=1
  1142. ENDIF
  1143. ENDIF
  1144. ELSE
  1145. CALL CRITPE(SIGTP(IHARDC), XZER, FG(2), -ISGNTC,XFFFS)
  1146. IF (ICASB.LE.2) THEN
  1147. ICASB = 5
  1148. ELSE
  1149. ICASB = 6
  1150. ENDIF
  1151. IF (XFFFS.GE.EPSIL(ICASB)) THEN
  1152. IHARDB = IHARDC
  1153. ISGNTCB = -ISGNTC
  1154. GOTO 3100
  1155. ENDIF
  1156. ENDIF
  1157. C
  1158. C Il faut faire suivre la petite surface si la grande se retrecit trop vite
  1159. C
  1160. IF (ICAS.LE.4) THEN
  1161. IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN
  1162. ICASB = ICAS +1
  1163. ELSE
  1164. ICASB = ICAS -1
  1165. ENDIF
  1166. XLIMIT = FG(1) -RESIST(ICASB)
  1167. IF (ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN
  1168. SIGHP(IHARDC) = XLIMIT
  1169. KONTAC(ICASB) = 1
  1170. ENDIF
  1171. IF (ICASB.LE.2) THEN
  1172. ICASB = ICASB +2
  1173. ELSE
  1174. ICASB = ICASB -2
  1175. ENDIF
  1176. XLIMIT = FG(2) -RESIST(ICASB)
  1177. IF (-ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN
  1178. SIGHP(IHARDC) = XLIMIT
  1179. KONTAC(ICASB) = 1
  1180. ENDIF
  1181. ENDIF
  1182. C
  1183. C
  1184. C Mis a jour des indicateurs de contact
  1185. C
  1186. KONTAC(ICAS) = 1
  1187. IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT.
  1188. &(RESIST(1)-RESIST(3))) THEN
  1189. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0
  1190. IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0
  1191. ELSE
  1192. KONTAC(1) = 1
  1193. KONTAC(2) = 1
  1194. KONTAC(3) = 1
  1195. KONTAC(4) = 1
  1196. ENDIF
  1197. SIGI(1) = SIGT(1)
  1198. SIGI(2) = SIGT(2)
  1199. SIGI(4) = SIGT(4)
  1200. DSIGI(1) = DSIGI(1)*SPLITT
  1201. DSIGI(2) = DSIGI(2)*SPLITT
  1202. DSIGI(4) = DSIGI(4)*SPLITT
  1203. SIGT(1) = SIGI(1) + DSIGI(1)
  1204. SIGT(2) = SIGI(2) + DSIGI(2)
  1205. SIGT(4) = SIGI(4) + DSIGI(4)
  1206. SIGHP0(1) = SIGHP(1)
  1207. SIGHP0(2) = SIGHP(2)
  1208. EPSI0(1) = EPSI(1)
  1209. EPSI0(2) = EPSI(2)
  1210. CPHI0 = CPHI
  1211. SPHI0 = SPHI
  1212. NPASS2 = 0
  1213. IF (ICAS.LE.2) THEN
  1214. ICAS = 5
  1215. ELSE
  1216. ICAS = 6
  1217. ENDIF
  1218. GOTO 1000
  1219. C
  1220. C
  1221. ELSE
  1222. GOTO 6000
  1223. ENDIF
  1224. C
  1225. C Cas ou on viole un critere lateral
  1226. C
  1227. 3100 CONTINUE
  1228. SIGHP(1) = SIGHP0(1)
  1229. SIGHP(2) = SIGHP0(2)
  1230. SIGT(1) = SIGI(1) + DSIGI(1)
  1231. SIGT(2) = SIGI(2) + DSIGI(2)
  1232. SIGT(4) = SIGI(4) + DSIGI(4)
  1233. CALL CONPRI ( SIGT ,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  1234. CALL VALEUR(EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1),
  1235. &DUMM,KERRE)
  1236. CALL VALEUR(EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2),
  1237. &DUMM,KERRE)
  1238. CALL CRITPE(SIGTP(IHARD), SIGHP(IHARD), RESIST(ICAS),
  1239. & ISGNTC, FFF(ICAS))
  1240. IF (ICASB.LE.4) THEN
  1241. CALL CRITPE(SIGTP(IHARDB), SIGHP(IHARDB), RESIST(ICASB),
  1242. & ISGNTCB, FFF(ICASB))
  1243. ELSE
  1244. FG(1) = XKISO(ICASB-4)*RESIST(ICASB)
  1245. CALL CRITPE (SIGTP(IHARDB), XZER, FG(1),
  1246. & ISGNTCB,FFF(ICASB))
  1247. ENDIF
  1248. IF (ICAS.LE.2) THEN
  1249. FG(1) = XKISO(1)*RESIST(5)
  1250. ELSE
  1251. FG(1) = XKISO(2)*RESIST(6)
  1252. ENDIF
  1253. CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC, XFFFS)
  1254. GOTO 5000
  1255. C================================================================
  1256. C CAS 4
  1257. C Deux mecanismes
  1258. C Petite et Grande surfaces (18/07)
  1259. C================================================================
  1260. 4000 CONTINUE
  1261. C
  1262. CALL CONPRI ( SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  1263. C
  1264. C
  1265. C Calcul de la normale a l'estimation elastique et du jacobien initial
  1266. C
  1267. IF (IHARD.EQ.1) THEN
  1268. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1269. ISGN2 = 1
  1270. ELSE
  1271. ISGN2 = -1
  1272. ENDIF
  1273. ELSE
  1274. IF (IHARD.EQ.2) THEN
  1275. IF (SIGTP(2).GE.SIGTP(1)) THEN
  1276. ISGN2 = 1
  1277. ELSE
  1278. ISGN2 = -1
  1279. ENDIF
  1280. ENDIF
  1281. ENDIF
  1282. C
  1283. IF (IHARDB.EQ.1) THEN
  1284. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1285. ISGN2B = 1
  1286. ELSE
  1287. ISGN2B = -1
  1288. ENDIF
  1289. ELSE
  1290. IF (IHARDB.EQ.2) THEN
  1291. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1292. ISGN2B = -1
  1293. ELSE
  1294. ISGN2B = 1
  1295. ENDIF
  1296. ENDIF
  1297. ENDIF
  1298. C
  1299. C
  1300. C
  1301. 4010 CONTINUE
  1302. C
  1303. C Definition du segment
  1304. C
  1305. ITM = 30
  1306. MN = 2
  1307. SEGINI,QUASIN
  1308. IT = -1
  1309. CALL ZERO(D,1,MN)
  1310. C
  1311. C XKISO et XHH2
  1312. C
  1313. IF (ICAS.LE.4) THEN
  1314. IF (ICASB.LE.4) THEN
  1315. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  1316. &XKISO(1),DUMM,KERRE)
  1317. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  1318. &XKISO(2),DUMM,KERRE)
  1319. ELSE
  1320. IF (ICASB.EQ.5) THEN
  1321. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1322. & ,XHH2B,KERRE)
  1323. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1324. & ,DUMM,KERRE)
  1325. ELSE
  1326. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1327. & ,DUMM,KERRE)
  1328. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1329. & ,XHH2B,KERRE)
  1330. ENDIF
  1331. ENDIF
  1332. ELSE
  1333. IF (ICASB.LE.4) THEN
  1334. IF (ICAS.EQ.5) THEN
  1335. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1336. & ,XHH2,KERRE)
  1337. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1338. & ,DUMM,KERRE)
  1339. ELSE
  1340. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1341. & ,DUMM,KERRE)
  1342. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1343. & ,XHH2,KERRE)
  1344. ENDIF
  1345. ELSE
  1346. IF (ICASB.EQ.5) THEN
  1347. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1348. & ,XHH2B,KERRE)
  1349. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1350. & ,XHH2,KERRE)
  1351. ELSE
  1352. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1353. & ,XHH2,KERRE)
  1354. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1355. & ,XHH2B,KERRE)
  1356. ENDIF
  1357. ENDIF
  1358. ENDIF
  1359. EPSI(1) = EPSI0(1)
  1360. EPSI(2) = EPSI0(2)
  1361. XHH2I = XHH2
  1362. XHH2IB = XHH2B
  1363. XKISO0(1) = XKISO(1)
  1364. XKISO0(2) = XKISO(2)
  1365. EPSII(1) = EPSI0(1)
  1366. EPSII(2) = EPSI0(2)
  1367. XKISOI(1) = XKISO(1)
  1368. XKISOI(2) = XKISO(2)
  1369. C
  1370. DO 4011,IE1=1,6
  1371. FFF(IE1) = XZER
  1372. 4011 CONTINUE
  1373. C
  1374. IF (ICAS.LE.4) THEN
  1375. CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD),RESIST(ICAS),
  1376. & ISGNTC,FFF(ICAS))
  1377. ELSE
  1378. FG(1) = XKISOI(ICAS-4)*RESIST(ICAS)
  1379. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FFF(ICAS))
  1380. ENDIF
  1381. C
  1382. IF (ICASB.LE.4) THEN
  1383. CALL CRITPE (SIGTP(IHARDB),SIGHP0(IHARDB),RESIST(ICASB),
  1384. & ISGNTCB,FFF(ICASB))
  1385. ELSE
  1386. FG(1) = XKISOI(ICASB-4)*RESIST(ICASB)
  1387. CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,FFF(ICASB))
  1388. ENDIF
  1389. C
  1390. C Jcobien initial
  1391. C
  1392. CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1)
  1393. CALL NORMBL(SIGT,RESIST(ICASB),ISGNTCB,ISGN2B,1,XNOR2)
  1394. C
  1395. XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU)
  1396. XJ00(1,2) = -XXCCYY(XNOR1, XNOR2, YOUN, XNU)
  1397. XJ00(2,1) = -XXCCYY(XNOR2, XNOR1, YOUN, XNU)
  1398. XJ00(2,2) = -XXCCYY(XNOR2, XNOR2, YOUN, XNU)
  1399. C
  1400. C Premier Mecanisme
  1401. C
  1402. IF (ICAS.LE.4) THEN
  1403. XJ00(1,1) = XJ00(1,1) - XHH1
  1404. ELSE
  1405. XJ00(1,1) = XJ00(1,1)-ISGNTC*RESIST(ICAS)*XHH2
  1406. IF ((ICASB.LE.4).AND.(ICAS.EQ.6)) THEN
  1407. XJ00(1,2) = XJ00(1,2)
  1408. & +RESIST(6)*XHH2*DEGRAD*ISGNTCB*RESIST(ICASB)
  1409. ENDIF
  1410. ENDIF
  1411. C
  1412. C Second Mecanisme
  1413. C
  1414. IF (ICASB.LE.4) THEN
  1415. XJ00(2,2) = XJ00(2,2) - XHH1
  1416. ELSE
  1417. XJ00(2,2) = XJ00(2,2)-ISGNTCB*RESIST(ICASB)*XHH2B
  1418. IF ((ICAS.LE.4).AND.(ICASB.EQ.6)) THEN
  1419. XJ00(2,1) = XJ00(2,1)
  1420. & +RESIST(6)*XHH2B*DEGRAD*ISGNTC*RESIST(ICAS)
  1421. ENDIF
  1422. ENDIF
  1423. C
  1424. C
  1425. R(1) = + FFF(ICAS)
  1426. R(2) = + FFF(ICASB)
  1427. GAMBDA(1) = XZER
  1428. GAMBDA(2) = XZER
  1429. GAMBDA(3) = XZER
  1430. GAMBDA(4) = XZER
  1431. GAMBDA(5) = XZER
  1432. GAMBDA(6) = XZER
  1433. C
  1434. C Inverse du jacobien
  1435. C
  1436. XH0(1,1) = XJ00(1,1)
  1437. XH0(1,2) = XJ00(1,2)
  1438. XH0(2,1) = XJ00(2,1)
  1439. XH0(2,2) = XJ00(2,2)
  1440. CALL INVALM (XH0, MN , MN , IRD, 1.D-12)
  1441. IF (IRD.NE.0) THEN
  1442. SEGSUP,QUASIN
  1443. GOTO 6000
  1444. ENDIF
  1445. C
  1446. C On rentre dans les iterations internes
  1447. C
  1448. DO I=0,ITM
  1449. C
  1450. C Appel de Broyden
  1451. C
  1452. CALL BROYDE (QUASIN)
  1453. C
  1454. GAMBDA(ICAS) = D(1)
  1455. GAMBDA(ICASB) = D(2)
  1456. C
  1457. C Calcul du phi et des termes de la matrice A et A-1
  1458. C
  1459. SITPRO(1) = SIGI(1) + DSIGI(1)
  1460. & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI
  1461. & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI
  1462. SITPRO(2) = SIGI(2) + DSIGI(2)
  1463. & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI
  1464. & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI
  1465. SITPRO(4) = SIGI(4) + DSIGI(4)
  1466. C
  1467. C PHI et AINV
  1468. C
  1469. SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3))
  1470. SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4))
  1471. EPSI(1) = EPSI0(1) + GAMBDA(5)
  1472. IF (ICAS.LE.4) THEN
  1473. WORK = GAMBDA(ICAS)*RESIST(ICAS)*ISGNTC
  1474. ELSE
  1475. WORK = XZER
  1476. ENDIF
  1477. IF (ICASB.LE.4) THEN
  1478. WORK = WORK + GAMBDA(ICASB)*RESIST(ICASB)*ISGNTCB
  1479. ENDIF
  1480. EPSI(2) = EPSI0(2) + GAMBDA(6) + DEGRAD*WORK
  1481. C
  1482. IF (ICAS.LE.4) THEN
  1483. IF (ICASB.LE.4) THEN
  1484. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  1485. &XKISO(1),DUMM,KERRE)
  1486. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  1487. &XKISO(2),DUMM,KERRE)
  1488. ELSE
  1489. IF (ICASB.EQ.5) THEN
  1490. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1491. & ,XHH2B,KERRE)
  1492. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1493. & ,DUMM,KERRE)
  1494. ELSE
  1495. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1496. & ,DUMM,KERRE)
  1497. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1498. & ,XHH2B,KERRE)
  1499. ENDIF
  1500. ENDIF
  1501. ELSE
  1502. IF (ICASB.LE.4) THEN
  1503. IF (ICAS.EQ.5) THEN
  1504. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1505. & ,XHH2,KERRE)
  1506. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1507. & ,DUMM,KERRE)
  1508. ELSE
  1509. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1510. & ,DUMM,KERRE)
  1511. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1512. & ,XHH2,KERRE)
  1513. ENDIF
  1514. ELSE
  1515. IF (ICASB.EQ.5) THEN
  1516. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1517. & ,XHH2B,KERRE)
  1518. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1519. & ,XHH2,KERRE)
  1520. ELSE
  1521. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1522. & ,XHH2,KERRE)
  1523. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1524. & ,XHH2B,KERRE)
  1525. ENDIF
  1526. ENDIF
  1527. ENDIF
  1528. C
  1529. C Calcul des phi
  1530. C
  1531. IF (ICAS.LE.4) THEN
  1532. PHI1=ISGNTC*(-UNDEMI*(SITPRO(1) + SITPRO(2))
  1533. & + SIGHP(IHARD) + RESIST(ICAS))
  1534. ELSE
  1535. PHI1= ISGNTC*(-UNDEMI*(SITPRO(1)+SITPRO(2))
  1536. & +(XKISOI(ICAS-4)+XHH2I*(EPSI(ICAS-4)-EPSII(ICAS-4)))
  1537. & *RESIST(ICAS))
  1538. ENDIF
  1539. C
  1540. IF (ICASB.LE.4) THEN
  1541. PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1) + SITPRO(2))
  1542. & + SIGHP(IHARDB)+ RESIST(ICASB))
  1543. ELSE
  1544. PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1)+SITPRO(2))
  1545. & +(XKISOI(ICASB-4)+XHH2IB*(EPSI(ICASB-4)-EPSII(ICASB-4)))
  1546. & *RESIST(ICASB))
  1547. ENDIF
  1548. C
  1549. C Test sur phi1 et phi2
  1550. C
  1551. IF ((ABS(PHI2)).GT.(ABS(EPSILO*RESIST(ICASB)))) THEN
  1552. SOMLAM = GAMBDA(ICAS) + GAMBDA(ICASB)*PHI1/PHI2
  1553. PHI = PHI1
  1554. ELSE
  1555. IF ((ABS(PHI1)).GT.(ABS(EPSILO*RESIST(ICAS)))) THEN
  1556. SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS)*PHI2/PHI1
  1557. PHI = PHI2
  1558. ELSE
  1559. SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS)
  1560. PHI = PHI1
  1561. ENDIF
  1562. ENDIF
  1563. C
  1564. AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM)
  1565. AINV(2) = (GGG*SOMLAM)/(DEUX*PHI + DEUX*GGG*SOMLAM)
  1566. AINV(3) = PHI/(PHI + GGG*SOMLAM)
  1567. C
  1568. C Calcul des contraintes a l'aide de AINV
  1569. C
  1570. SIGT(1) = AINV(1)*SITPRO(1)+AINV(2)*SITPRO(2)
  1571. SIGT(2) = AINV(2)*SITPRO(1)+AINV(1)*SITPRO(2)
  1572. SIGT(4) = AINV(3)*SITPRO(4)
  1573. C
  1574. C Nouvelles contraintes principales
  1575. C
  1576. CALL CONPRI ( SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  1577. C
  1578. C
  1579. IF (ICAS.LE.4) THEN
  1580. CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD),RESIST(ICAS),
  1581. & ISGNTC,FFF(ICAS))
  1582. R(1)= + FFF(ICAS)
  1583. ELSE
  1584. FG(1) = (XKISOI(ICAS-4)+XHH2I*(EPSI(ICAS-4)-EPSII(ICAS-4)))
  1585. & *RESIST(ICAS)
  1586. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FFF(ICAS))
  1587. R(1) = + FFF(ICAS)
  1588. & - ISGNTC*RESIST(ICAS)
  1589. & * (XKISO(ICAS-4) - XKISOI(ICAS-4)
  1590. & -(EPSI(ICAS-4) - EPSII(ICAS-4))*XHH2I)
  1591. IF (ABS(EPSI(ICAS-4) - EPSII(ICAS-4)).LT.EPSILO2) THEN
  1592. XHH2I=XHH2
  1593. ELSE
  1594. XHH2I = (XKISO(ICAS-4) - XKISOI(ICAS-4))/
  1595. & (EPSI(ICAS-4) - EPSII(ICAS-4))
  1596. ENDIF
  1597. EPSII(ICAS-4) = EPSI(ICAS-4)
  1598. XKISOI(ICAS-4) = XKISO(ICAS-4)
  1599. ENDIF
  1600. C
  1601. IF (ICASB.LE.4) THEN
  1602. CALL CRITPE (SIGTP(IHARDB),SIGHP(IHARDB),RESIST(ICASB),
  1603. & ISGNTCB,FFF(ICASB))
  1604. R(2)= + FFF(ICASB)
  1605. ELSE
  1606. FG(1) = (XKISOI(ICASB-4)+XHH2IB*(EPSI(ICASB-4) -
  1607. & EPSII(ICASB-4)))*RESIST(ICASB)
  1608. CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,FFF(ICASB))
  1609. R(2) = + FFF(ICASB)
  1610. & - ISGNTCB*RESIST(ICASB)
  1611. & * (XKISO(ICASB-4) - XKISOI(ICASB-4)
  1612. & -(EPSI(ICASB-4) - EPSII(ICASB-4))*XHH2IB)
  1613. IF (ABS(EPSI(ICASB-4) - EPSII(ICASB-4)).LT.EPSILO2) THEN
  1614. XHH2IB=XHH2B
  1615. ELSE
  1616. XHH2IB = (XKISO(ICASB-4) - XKISOI(ICASB-4))/
  1617. & (EPSI(ICASB-4) - EPSII(ICASB-4))
  1618. ENDIF
  1619. XKISOI(ICASB-4) = XKISO(ICASB-4)
  1620. EPSII(ICASB-4) = EPSI(ICASB-4)
  1621. ENDIF
  1622. C
  1623. C Test de convergence
  1624. C
  1625. IF ((ABS(FFF(ICAS)).LE.EPSIL(ICAS))
  1626. &.AND.(ABS(FFF(ICASB)).LE.EPSIL(ICASB)).AND.
  1627. &(ABS(R(1)).LE.EPSIL(ICAS)).AND.(ABS(R(2)).LE.EPSIL(ICASB))) THEN
  1628. GOTO 4020
  1629. ENDIF
  1630. ENDDO
  1631. C
  1632. C Pas de convergence
  1633. C
  1634. SEGSUP,QUASIN
  1635. GOTO 6000
  1636. C
  1637. 4020 CONTINUE
  1638. SEGSUP,QUASIN
  1639. C
  1640. IF ((GAMBDA(ICAS).LT.EPSILO2).OR.
  1641. &(GAMBDA(ICASB).LT.EPSILO2)) THEN
  1642. 4030 CONTINUE
  1643. IF (NPASS.LE.5) THEN
  1644. NPASS = NPASS + 1
  1645. ELSE
  1646. GOTO 6000
  1647. ENDIF
  1648. IF ((GAMBDA(ICAS).LT.EPSILO2).AND.
  1649. &(GAMBDA(ICASB).LT.EPSILO2)) THEN
  1650. C Ce cas n'arrive que si les normales ont ete mal estimes:
  1651. C (increment elastique trop grand) --> on bissecte
  1652. GOTO 6000
  1653. ELSE
  1654. IF (GAMBDA(ICAS).LT.EPSILO2) THEN
  1655. ICAS = ICASB
  1656. IHARD = IHARDB
  1657. ISGNTC = ISGNTCB
  1658. ELSE
  1659. CONTINUE
  1660. ENDIF
  1661. ENDIF
  1662. SIGHP(1) = SIGHP0(1)
  1663. SIGHP(2) = SIGHP0(2)
  1664. SIGT(1) = SIGI(1) + DSIGI(1)
  1665. SIGT(2) = SIGI(2) + DSIGI(2)
  1666. SIGT(4) = SIGI(4) + DSIGI(4)
  1667. GOTO 1000
  1668. ENDIF
  1669. C On teste les mecanismes de la grande surface
  1670. C Si un des criteres est viole (et donc s'il n'y a pas contact)
  1671. C il faut trouver le point de contact
  1672. C
  1673. CALL CONPRI ( SIGT ,CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  1674. C
  1675. NCON = 0
  1676. FINT1 = 0.
  1677. FINT2 = 0.
  1678. C
  1679. XFFFS = XZER
  1680. XFFFSB = XZER
  1681. IF (ICAS.LE.4) THEN
  1682. IF (ICAS.LE.2) THEN
  1683. FG(1) = XKISO(1)*RESIST(5)
  1684. ELSE
  1685. FG(1) = XKISO(2)*RESIST(6)
  1686. ENDIF
  1687. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,XFFFS)
  1688. IF (((XFFFS.GE.EPSIL(5)).AND.(ICAS.LE.2)).OR.
  1689. & ((XFFFS.GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN
  1690. NCON = NCON +1
  1691. ELSE
  1692. IF (((ICAS.LE.2).AND.(ABS(XFFFS).LT.EPSIL(5))).OR.
  1693. &((ICAS.GE.3).AND.(ABS(XFFFS).LT.EPSIL(6)))) THEN
  1694. KONTAC(ICAS) = 1
  1695. ELSE
  1696. CONTINUE
  1697. ENDIF
  1698. ENDIF
  1699. ENDIF
  1700. C
  1701. IF (ICASB.LE.4) THEN
  1702. IF (ICASB.LE.2) THEN
  1703. FG(1) = XKISO(1)*RESIST(5)
  1704. ELSE
  1705. FG(1) = XKISO(2)*RESIST(6)
  1706. ENDIF
  1707. CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,XFFFSB)
  1708. IF (((XFFFSB.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  1709. & ((XFFFSB.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  1710. NCON = NCON +1
  1711. ELSE
  1712. IF (((ICASB.LE.2).AND.(ABS(XFFFSB).LT.EPSIL(5))).OR.
  1713. &((ICASB.GT.3).AND.(ABS(XFFFSB).LT.EPSIL(6)))) THEN
  1714. KONTAC(ICASB) = 1
  1715. ELSE
  1716. CONTINUE
  1717. ENDIF
  1718. ENDIF
  1719. ENDIF
  1720. C
  1721. IF (NCON.EQ.1) THEN
  1722. IF (((XFFFS.GE.EPSIL(5)).AND.(ICAS.LE.2)).OR.
  1723. & ((XFFFS.GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN
  1724. GOTO 4040
  1725. ELSE
  1726. ICASI = ICAS
  1727. ISGNTCI = ISGNTC
  1728. IHARDI = IHARD
  1729. ICAS = ICASB
  1730. ISGNTC = ISGNTCB
  1731. IHARD = IHARDB
  1732. ICASB = ICASI
  1733. ISGNTCB = ISGNTCI
  1734. IHARDB = IHARDI
  1735. GOTO 4040
  1736. ENDIF
  1737. ELSE
  1738. IF (NCON.EQ.2) THEN
  1739. GOTO 4040
  1740. ELSE
  1741. CONTINUE
  1742. ENDIF
  1743. CONTINUE
  1744. ENDIF
  1745. C
  1746. C Regles de suivi avant de sortir normalement
  1747. C Direction de l'ecoulement
  1748. IF (ICAS.GE.5) THEN
  1749. SIGHP(IHARD) = XKISO(ICAS-4)*RESIST(ICAS)
  1750. & -RESIST(2*ICAS-10+IHARD)
  1751. ENDIF
  1752. IF (ICASB.GE.5) THEN
  1753. SIGHP(IHARDB) = XKISO(ICASB-4)*RESIST(ICASB)
  1754. & -RESIST(2*ICASB-10+IHARDB)
  1755. ENDIF
  1756. C
  1757. C Mis a jour des indicateurs de contact
  1758. C
  1759. IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT.
  1760. &(RESIST(1)-RESIST(3))) THEN
  1761. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0
  1762. IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0
  1763. IF ((ICASB.EQ.1).OR.(ICASB.EQ.2)) KONTAC(ICASB+2)=0
  1764. IF ((ICASB.EQ.3).OR.(ICASB.EQ.4)) KONTAC(ICASB-2)=0
  1765. ELSE
  1766. KONTAC(1) = 1
  1767. KONTAC(2) = 1
  1768. KONTAC(3) = 1
  1769. KONTAC(4) = 1
  1770. ENDIF
  1771. C
  1772. GOTO 9999
  1773. C
  1774. C On va au contact
  1775. 4040 CONTINUE
  1776. SIGHP(1) = SIGHP0(1)
  1777. SIGHP(2) = SIGHP0(2)
  1778. SIGT(1) = SIGI(1) + DSIGI(1)
  1779. SIGT(2) = SIGI(2) + DSIGI(2)
  1780. SIGT(4) = SIGI(4) + DSIGI(4)
  1781. EPSI(1) = EPSI0(1)
  1782. EPSI(2) = EPSI0(2)
  1783. GOTO 5000
  1784. C================================================================
  1785. C CAS 5
  1786. C Deux mecanismes avec
  1787. C Entree en contact de 2 mecanismes
  1788. C================================================================
  1789. 5000 CONTINUE
  1790. C
  1791. CALL CONPRI ( SIGT , CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  1792. C
  1793. C ISGN2 et ISGN2B
  1794. IF (IHARD.EQ.1) THEN
  1795. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1796. ISGN2 = 1
  1797. ELSE
  1798. ISGN2 = -1
  1799. ENDIF
  1800. ELSE
  1801. IF (IHARD.EQ.2) THEN
  1802. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1803. ISGN2 = -1
  1804. ELSE
  1805. ISGN2 = 1
  1806. ENDIF
  1807. ENDIF
  1808. ENDIF
  1809. C
  1810. IF (IHARDB.EQ.1) THEN
  1811. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1812. ISGN2B = 1
  1813. ELSE
  1814. ISGN2B = -1
  1815. ENDIF
  1816. ELSE
  1817. IF (IHARDB.EQ.2) THEN
  1818. IF (SIGTP(1).GE.SIGTP(2)) THEN
  1819. ISGN2B = -1
  1820. ELSE
  1821. ISGN2B = 1
  1822. ENDIF
  1823. ENDIF
  1824. ENDIF
  1825. C
  1826. 5010 CONTINUE
  1827. C
  1828. C Definition du segment
  1829. C
  1830. ITM = 30
  1831. MN = 3
  1832. SEGINI,QUASIN
  1833. IT = -1
  1834. CALL ZERO(D,1,MN)
  1835. C XKISO et XHH2
  1836. IF (ICASB.LE.4) THEN
  1837. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  1838. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  1839. &XKISO(1),XHH2,KERRE)
  1840. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  1841. &XKISO(2),DUMM,KERRE)
  1842. ELSE
  1843. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,
  1844. &XKISO(1),DUMM,KERRE)
  1845. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,
  1846. &XKISO(2),XHH2,KERRE)
  1847. ENDIF
  1848. ELSE
  1849. IF (ICASB.EQ.5) THEN
  1850. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  1851. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1852. & ,XHH2,KERRE)
  1853. XHH2B=XHH2
  1854. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1855. & ,DUMM,KERRE)
  1856. ELSE
  1857. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1858. & ,XHH2B,KERRE)
  1859. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1860. & ,XHH2,KERRE)
  1861. ENDIF
  1862. ELSE
  1863. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  1864. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1865. & ,XHH2,KERRE)
  1866. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1867. & ,XHH2B,KERRE)
  1868. ELSE
  1869. CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  1870. & ,DUMM,KERRE)
  1871. CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  1872. & ,XHH2,KERRE)
  1873. XHH2B = XHH2
  1874. ENDIF
  1875. ENDIF
  1876. ENDIF
  1877. C
  1878. XKISO0(1)=XKISO(1)
  1879. EPSI(1)=EPSI0(1)
  1880. XKISO0(2)=XKISO(2)
  1881. EPSI(2)=EPSI0(2)
  1882. XHH2I = XHH2
  1883. XHH2IB = XHH2B
  1884. XKISOI(1)=XKISO(1)
  1885. XKISOI(2)=XKISO(2)
  1886. EPSII(1)=EPSI0(1)
  1887. EPSII(2)=EPSI0(2)
  1888. C
  1889. DO 5011,IE1=1,6
  1890. FFF(IE1) = XZER
  1891. 5011 CONTINUE
  1892. C
  1893. CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD),RESIST(ICAS),
  1894. & ISGNTC,FFF(ICAS))
  1895. C
  1896. IF (ICASB.LE.4) THEN
  1897. CALL CRITPE (SIGTP(IHARDB),SIGHP0(IHARDB),RESIST(ICASB),
  1898. & ISGNTCB,FFF(ICASB))
  1899. ELSE
  1900. FG(1) = XKISOI(ICASB -4)*RESIST(ICASB)
  1901. CALL CRITPE (SIGTP(IHARDB), XZER, FG(1),ISGNTCB,FFF(ICASB))
  1902. ENDIF
  1903. C
  1904. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  1905. FG(1) = XKISO(1)*RESIST(5)
  1906. CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC,XFFFS)
  1907. ELSE
  1908. FG(1) = XKISO(2)*RESIST(6)
  1909. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,XFFFS)
  1910. ENDIF
  1911. C
  1912. CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1)
  1913. CALL NORMBL(SIGT,RESIST(ICASB),ISGNTCB,ISGN2B,1,XNOR2)
  1914. C
  1915. C Jacobien
  1916. C
  1917. XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU) - XHH1
  1918. XJ00(1,2) = -XXCCYY(XNOR1, XNOR2, YOUN, XNU)
  1919. XJ00(1,3) = -XXYY(XNOR1 , DSIGI)
  1920. XJ00(2,1) = -XXCCYY(XNOR2, XNOR1, YOUN, XNU)
  1921. XJ00(2,2) = -XXCCYY(XNOR2, XNOR2, YOUN, XNU)
  1922. XJ00(2,3) = -XXYY(XNOR2,DSIGI)
  1923. XJ00(3,1) = -XXCCYY(XNOR1,XNOR1,YOUN,XNU)
  1924. XJ00(3,2) = -XXCCYY(XNOR1,XNOR2,YOUN,XNU)
  1925. XJ00(3,3) = -XXYY(XNOR1,DSIGI)
  1926. C
  1927. IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) THEN
  1928. XJ00(3,1)=XJ00(3,1)+RESIST(6)*XHH2*DEGRAD*ISGNTC*RESIST(ICAS)
  1929. ENDIF
  1930. C
  1931. IF (ICASB.LE.4) THEN
  1932. XJ00(2,2) = XJ00(2,2) - XHH1
  1933. IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) THEN
  1934. XJ00(3,2)=XJ00(3,2)+RESIST(6)*XHH2
  1935. &*DEGRAD*ISGNTCB*RESIST(ICASB)
  1936. ENDIF
  1937. ELSE
  1938. XJ00(2,2) = XJ00(2,2) - RESIST(ICASB)*XHH2B*ISGNTCB
  1939. ENDIF
  1940. C
  1941. C
  1942. R(1) = FFF(ICAS)
  1943. R(2) = FFF(ICASB)
  1944. R(3) = XFFFS
  1945. C
  1946. SPLITT = XZER
  1947. GAMBDA(1) = XZER
  1948. GAMBDA(2) = XZER
  1949. GAMBDA(3) = XZER
  1950. GAMBDA(4) = XZER
  1951. GAMBDA(5) = XZER
  1952. GAMBDA(6) = XZER
  1953. C
  1954. C Inverse du jacobien
  1955. C
  1956. XH0(1,1) = XJ00(1,1)
  1957. XH0(1,2) = XJ00(1,2)
  1958. XH0(1,3) = XJ00(1,3)
  1959. XH0(2,1) = XJ00(2,1)
  1960. XH0(2,2) = XJ00(2,2)
  1961. XH0(2,3) = XJ00(2,3)
  1962. XH0(3,1) = XJ00(3,1)
  1963. XH0(3,2) = XJ00(3,2)
  1964. XH0(3,3) = XJ00(3,3)
  1965. CALL INVALM (XH0, MN , MN , IRD, 1.D-12)
  1966. IF (IRD.NE.0) THEN
  1967. SEGSUP,QUASIN
  1968. GOTO 6000
  1969. ENDIF
  1970. C
  1971. C On rentre dans les iterations internes
  1972. C
  1973. DO I=0,ITM
  1974. C
  1975. C Appel de Broyden
  1976. C
  1977. CALL BROYDE (QUASIN)
  1978. C
  1979. GAMBDA(ICAS) = D(1)
  1980. GAMBDA(ICASB) = D(2)
  1981. SPLITT = D(3)
  1982. C
  1983. C Calcul du phi et des termes de la matrice A et A-1
  1984. C
  1985. SITPRO(1) = SIGI(1) + (UN-SPLITT)*DSIGI(1)
  1986. & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI
  1987. & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI
  1988. SITPRO(2) = SIGI(2) + (UN-SPLITT)*DSIGI(2)
  1989. & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI
  1990. & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI
  1991. SITPRO(4) = SIGI(4) + (UN-SPLITT)*DSIGI(4)
  1992. C
  1993. C PHI et AINV
  1994. C
  1995. SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3))
  1996. SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4))
  1997. EPSI(1) = EPSI0(1) + GAMBDA(5)
  1998. WORK = ISGNTC*RESIST(ICAS)*GAMBDA(ICAS)
  1999. IF (ICASB.LE.4) THEN
  2000. WORK = WORK + ISGNTCB*RESIST(ICASB)*GAMBDA(ICASB)
  2001. ENDIF
  2002. EPSI(2)=EPSI0(2)+ GAMBDA(6) + DEGRAD*WORK
  2003. C
  2004. IF (ICASB.LE.4) THEN
  2005. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  2006. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  2007. &XKISO(1),XHH2,KERRE)
  2008. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  2009. &XKISO(2),DUMM,KERRE)
  2010. ELSE
  2011. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  2012. &XKISO(1),DUMM,KERRE)
  2013. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  2014. &XKISO(2),XHH2,KERRE)
  2015. ENDIF
  2016. ELSE
  2017. IF (ICASB.EQ.5) THEN
  2018. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  2019. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  2020. & ,XHH2,KERRE)
  2021. XHH2B=XHH2
  2022. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  2023. & ,DUMM,KERRE)
  2024. ELSE
  2025. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  2026. & ,XHH2B,KERRE)
  2027. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  2028. & ,XHH2,KERRE)
  2029. ENDIF
  2030. ELSE
  2031. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  2032. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  2033. & ,XHH2,KERRE)
  2034. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  2035. & ,XHH2B,KERRE)
  2036. ELSE
  2037. CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1)
  2038. & ,DUMM,KERRE)
  2039. CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2)
  2040. & ,XHH2,KERRE)
  2041. XHH2B = XHH2
  2042. ENDIF
  2043. ENDIF
  2044. ENDIF
  2045. C
  2046. C Calcul des phi
  2047. C
  2048. PHI1=ISGNTC*(-UNDEMI*(SITPRO(1) + SITPRO(2))
  2049. & + SIGHP(IHARD) + RESIST(ICAS))
  2050. C
  2051. IF (ICASB.LE.4) THEN
  2052. PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1) + SITPRO(2))
  2053. & + SIGHP(IHARDB)+ RESIST(ICASB))
  2054. ELSE
  2055. PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1)+SITPRO(2))
  2056. & + (XKISOI(ICASB-4)+XHH2IB*(EPSI(ICASB-4)-EPSII(ICASB-4)))
  2057. & *RESIST(ICASB))
  2058. ENDIF
  2059. C
  2060. C Test sur phi1 et phi2
  2061. C
  2062. IF ((ABS(PHI2)).GT.(ABS(EPSILO*RESIST(ICASB)))) THEN
  2063. SOMLAM = GAMBDA(ICAS) + GAMBDA(ICASB)*PHI1/PHI2
  2064. PHI = PHI1
  2065. ELSE
  2066. IF ((ABS(PHI1)).GT.(ABS(EPSILO*RESIST(ICAS)))) THEN
  2067. SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS)*PHI2/PHI1
  2068. PHI = PHI2
  2069. ELSE
  2070. SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS)
  2071. PHI = PHI1
  2072. ENDIF
  2073. ENDIF
  2074. C
  2075. AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM)
  2076. AINV(2) = (GGG*SOMLAM)/(DEUX*PHI + DEUX*GGG*SOMLAM)
  2077. AINV(3) = PHI/(PHI + GGG*SOMLAM)
  2078. C
  2079. C Calcul des contraintes a l'aide de AINV
  2080. C
  2081. SIGT(1) = AINV(1)*SITPRO(1)+AINV(2)*SITPRO(2)
  2082. SIGT(2) = AINV(2)*SITPRO(1)+AINV(1)*SITPRO(2)
  2083. SIGT(4) = AINV(3)*SITPRO(4)
  2084. C
  2085. C Nouvelles contraintes principales
  2086. C
  2087. CALL CONPRI ( SIGT , CPHI0,SPHI0,SIGTP,CPHI,SPHI)
  2088. C
  2089. CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD),RESIST(ICAS),
  2090. & ISGNTC,FFF(ICAS))
  2091. R(1)= + FFF(ICAS)
  2092. C
  2093. IF (ICASB.LE.4) THEN
  2094. CALL CRITPE (SIGTP(IHARDB),SIGHP(IHARDB),RESIST(ICASB),
  2095. & ISGNTCB,FFF(ICASB))
  2096. R(2)= + FFF(ICASB)
  2097. ELSE
  2098. FG(1) = (XKISOI(ICASB -4)+XHH2IB*(EPSI(ICASB-4)
  2099. & - EPSII(ICASB-4)))*RESIST(ICASB)
  2100. CALL CRITPE (SIGTP(IHARDB), XZER, FG(1),ISGNTCB,FFF(ICASB))
  2101. R(2) = + FFF(ICASB)
  2102. & - ISGNTCB*RESIST(ICASB)
  2103. & * (XKISO(ICASB-4) - XKISOI(ICASB-4)
  2104. & -(EPSI(ICASB-4) - EPSII(ICASB-4))*XHH2IB)
  2105. IF (ABS(EPSI(ICASB-4) - EPSII(ICASB-4)).LT.EPSILO2) THEN
  2106. XHH2IB=XHH2B
  2107. ELSE
  2108. XHH2IB = (XKISO(ICASB-4) - XKISOI(ICASB-4))/
  2109. & (EPSI(ICASB-4) - EPSII(ICASB-4))
  2110. ENDIF
  2111. ENDIF
  2112. C
  2113. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  2114. FG(1) = XKISO(1)*RESIST(5)
  2115. CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC,XFFFS)
  2116. R(3) = XFFFS
  2117. ELSE
  2118. FG(1) = (XKISOI(2)+XHH2I*(EPSI(2)-EPSII(2)))*RESIST(6)
  2119. CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,XFFFS)
  2120. R(3) = XFFFS + RESIST(6)*
  2121. & (XKISO(2) - XKISOI(2)-(EPSI(2) - EPSII(2))*XHH2I)
  2122. IF (ABS(EPSI(2) - EPSII(2)).LT.EPSILO2) THEN
  2123. XHH2I=XHH2
  2124. ELSE
  2125. XHH2I = (XKISO(2) - XKISOI(2))/
  2126. & (EPSI(2) - EPSII(2))
  2127. ENDIF
  2128. ENDIF
  2129. XKISOI(1) = XKISO(1)
  2130. EPSII(1) = EPSI(1)
  2131. XKISOI(2) = XKISO(2)
  2132. EPSII(2) = EPSI(2)
  2133. C
  2134. C Test de convergence
  2135. C
  2136. IF (ICAS.LE.2) THEN
  2137. IF ((ABS(FFF(ICAS)).LT.EPSIL(ICAS)).AND.
  2138. & (ABS(R(1)).LT.EPSIL(ICAS)).AND.
  2139. & (ABS(FFF(ICASB)).LT.EPSIL(ICASB)).AND.
  2140. & (ABS(R(2)).LT.EPSIL(ICASB)).AND.
  2141. & (ABS(XFFFS).LT.EPSIL(5)).AND.
  2142. & (ABS(R(3)).LT.EPSIL(5))) THEN
  2143. GOTO 5020
  2144. ENDIF
  2145. ELSE
  2146. IF ((ABS(FFF(ICAS)).LT.EPSIL(ICAS)).AND.
  2147. & (ABS(R(1)).LT.EPSIL(ICAS)).AND.
  2148. & (ABS(FFF(ICASB)).LT.EPSIL(ICASB)).AND.
  2149. & (ABS(R(2)).LT.EPSIL(ICASB)).AND.
  2150. & (ABS(XFFFS).LT.EPSIL(6)).AND.
  2151. & (ABS(R(3)).LT.EPSIL(6))) THEN
  2152. GOTO 5020
  2153. ENDIF
  2154. ENDIF
  2155. ENDDO
  2156. C
  2157. C Pas de convergence
  2158. C
  2159. SEGSUP,QUASIN
  2160. GOTO 6000
  2161. C
  2162. 5020 CONTINUE
  2163. SEGSUP,QUASIN
  2164. C
  2165. C
  2166. IF (((SPLITT-1.).LE.EPSILO).AND.(SPLITT.GE.(-1.*EPSILO)).AND.
  2167. &(GAMBDA(ICAS).GE.EPSILO2)
  2168. &.AND.(GAMBDA(ICASB).GE.EPSILO2)) THEN
  2169. C
  2170. C On a les contraintes, les variables d'ecrouissage cinemat. et tgphi
  2171. C Mis a jour des variables d'ecrouissage isotrope ou regles de suivi
  2172. C
  2173.  
  2174. IF (NCON.EQ.2) THEN
  2175. IF (ICASB.LE.4) THEN
  2176. C
  2177. IF (ICASB.LE.2) THEN
  2178. FG(1) = XKISO(1)*RESIST(5)
  2179. ELSE
  2180. FG(1) = XKISO(2)*RESIST(6)
  2181. ENDIF
  2182. CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,XFFFSB)
  2183. C
  2184. C On regarde si on ne s'est pas trompe d'ordre
  2185. C
  2186. IF (((XFFFSB.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR.
  2187. & ((XFFFSB.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN
  2188. ICASI = ICAS
  2189. ISGNTCI = ISGNTC
  2190. IHARDI = IHARD
  2191. ICAS = ICASB
  2192. ISGNTC = ISGNTCB
  2193. IHARD = IHARDB
  2194. ICASB = ICASI
  2195. ISGNTCB = ISGNTCI
  2196. IHARDB = IHARDI
  2197. GOTO 4040
  2198. ELSE
  2199. IF ((ICASB.LE.2).AND.(ABS(XFFFSB).LT.EPSIL(5))) THEN
  2200. KONTAC(ICASB) = 1
  2201. ICASB=5
  2202. ENDIF
  2203. IF (((ICASB.EQ.3).OR.(ICASB.EQ.4))
  2204. & .AND.(ABS(XFFFSB).LT.EPSIL(6))) THEN
  2205. KONTAC(ICASB) = 1
  2206. ICASB=6
  2207. ENDIF
  2208. ENDIF
  2209. C
  2210. ELSE
  2211. CONTINUE
  2212. ENDIF
  2213. ELSE
  2214. CONTINUE
  2215. ENDIF
  2216. C
  2217. C Le contact est realise
  2218. C
  2219. KONTAC(ICAS) = 1
  2220. IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT.
  2221. &(RESIST(1)-RESIST(3))) THEN
  2222. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0
  2223. IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0
  2224. IF ((ICASB.EQ.1).OR.(ICASB.EQ.2)) KONTAC(ICASB+2)=0
  2225. IF ((ICASB.EQ.3).OR.(ICASB.EQ.4)) KONTAC(ICASB-2)=0
  2226. ELSE
  2227. KONTAC(1) = 1
  2228. KONTAC(2) = 1
  2229. KONTAC(3) = 1
  2230. KONTAC(4) = 1
  2231. ENDIF
  2232. C
  2233. SIGI(1) = SIGT(1)
  2234. SIGI(2) = SIGT(2)
  2235. SIGI(4) = SIGT(4)
  2236. DSIGI(1) = DSIGI(1)*SPLITT
  2237. DSIGI(2) = DSIGI(2)*SPLITT
  2238. DSIGI(4) = DSIGI(4)*SPLITT
  2239. SIGT(1) = SIGI(1) + DSIGI(1)
  2240. SIGT(2) = SIGI(2) + DSIGI(2)
  2241. SIGT(4) = SIGI(4) + DSIGI(4)
  2242. SIGHP0(1) = SIGHP(1)
  2243. SIGHP0(2) = SIGHP(2)
  2244. EPSI0(1) = EPSI(1)
  2245. EPSI0(2) = EPSI(2)
  2246. NPASS2 = 0
  2247. CPHI0 = CPHI
  2248. SPHI0 = SPHI
  2249. IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN
  2250. ICAS = 5
  2251. ELSE
  2252. ICAS = 6
  2253. ENDIF
  2254. IF (ICASB.LE.4) THEN
  2255. GOTO 4000
  2256. ELSE
  2257. IF (ICASB.EQ.ICAS) THEN
  2258. C On passe de 2 mecanismes a 1 mecanisme
  2259. GOTO 1000
  2260. ELSE
  2261. GOTO 4000
  2262. ENDIF
  2263. ENDIF
  2264. C
  2265. C
  2266. ELSE
  2267. 5040 CONTINUE
  2268. IF ((GAMBDA(ICASB).LT.EPSILO2).AND.(NPASS.LE.3)) THEN
  2269. SIGHP(1) = SIGHP0(1)
  2270. SIGHP(2) = SIGHP0(2)
  2271. SIGT(1) = SIGI(1) + DSIGI(1)
  2272. SIGT(2) = SIGI(2) + DSIGI(2)
  2273. SIGT(4) = SIGI(4) + DSIGI(4)
  2274. IF (NPASS.LT.5) THEN
  2275. NPASS = NPASS + 1
  2276. GOTO 3000
  2277. ELSE
  2278. GOTO 6000
  2279. ENDIF
  2280. ELSE
  2281. IF ((GAMBDA(ICAS).LT.EPSILO2).AND.(NPASS2.EQ.0)) THEN
  2282. NPASS2 = 1
  2283. SIGHP(1) = SIGHP0(1)
  2284. SIGHP(2) = SIGHP0(2)
  2285. SIGT(1) = SIGI(1) + DSIGI(1)
  2286. SIGT(2) = SIGI(2) + DSIGI(2)
  2287. SIGT(4) = SIGI(4) + DSIGI(4)
  2288. ICAS = ICASB
  2289. IHARD = IHARDB
  2290. ISGNTC = ISGNTCB
  2291. IF (NPASS.LT.5) THEN
  2292. NPASS = NPASS + 1
  2293. GOTO 1000
  2294. ELSE
  2295. GOTO 6000
  2296. ENDIF
  2297. ELSE
  2298. GOTO 6000
  2299. ENDIF
  2300. ENDIF
  2301. ENDIF
  2302. C
  2303. C On bissecte
  2304. C
  2305. 6000 CONTINUE
  2306. NDICHO = NDICHO + 1
  2307. IF (NDICHO.LE.90) THEN
  2308. IDICHO = 1
  2309. DSIGIDI(1) = DSIGIDI(1) + UNDEMI*DSIGI(1)
  2310. DSIGIDI(2) = DSIGIDI(2) + UNDEMI*DSIGI(2)
  2311. DSIGIDI(4) = DSIGIDI(4) + UNDEMI*DSIGI(4)
  2312. DSIGI(1) = DSIGI(1)*UNDEMI
  2313. DSIGI(2) = DSIGI(2)*UNDEMI
  2314. DSIGI(4) = DSIGI(4)*UNDEMI
  2315. CPHI0 = CPHI00
  2316. SPHI0 = SPHI00
  2317. GOTO 10
  2318. ELSE
  2319. KERRE = 2
  2320. RETURN
  2321. ENDIF
  2322. C
  2323. C=================================================================
  2324. C MIS A JOUR DE TOUTES LES VARIABLES ET CONTRAINTES AVANT
  2325. C DE SORTIR
  2326. C=================================================================
  2327. 9999 CONTINUE
  2328. C Cas de la bissection
  2329. IF (IDICHO.EQ.1) THEN
  2330. IDICHO = 0
  2331. NDICHO = 0
  2332. NPASS = 0
  2333. DSIGI(1) = DSIGIDI(1)
  2334. DSIGI(2) = DSIGIDI(2)
  2335. DSIGI(4) = DSIGIDI(4)
  2336. SIGI(1) = SIGT(1)
  2337. SIGI(2) = SIGT(2)
  2338. SIGI(4) = SIGT(4)
  2339. DSIGIDI(1) = XZER
  2340. DSIGIDI(2) = XZER
  2341. DSIGIDI(4) = XZER
  2342. SIGHP0(1) = SIGHP(1)
  2343. SIGHP0(2) = SIGHP(2)
  2344. EPSI0(1) = EPSI(1)
  2345. EPSI0(2) = EPSI(2)
  2346. CPHI0 = CPHI
  2347. CPHI00 = CPHI0
  2348. SPHI0 = SPHI
  2349. SPHI00 = SPHI0
  2350. KONTA0(1) = KONTAC(1)
  2351. KONTA0(2) = KONTAC(2)
  2352. KONTA0(3) = KONTAC(3)
  2353. KONTA0(4) = KONTAC(4)
  2354. GOTO 10
  2355. ENDIF
  2356. C STRESS
  2357. SIGF(1) = SIGT(1)
  2358. SIGF(2) = SIGT(2)
  2359. SIGF(4) = SIGT(4)
  2360. SIGF(3) = XZER
  2361. C PLASTIC STRAIN
  2362. CINV(1) = UN/YOUN
  2363. CINV(2) = -XNU/YOUN
  2364. CINV(3) = UN/GGG
  2365. DEFP(1) =CINV(1)*(SIG0(1) + DSIGT(1) - SIGT(1))
  2366. & +CINV(2)*(SIG0(2) + DSIGT(2) - SIGT(2))
  2367. DEFP(2) =CINV(2)*(SIG0(1) + DSIGT(1) - SIGT(1))
  2368. & +CINV(1)*(SIG0(2) + DSIGT(2) - SIGT(2))
  2369. DEFP(4) =CINV(3)*(SIG0(4) + DSIGT(4) - SIGT(4))
  2370. DEFP(3) = XZER
  2371. C
  2372. C Cas ou la grande surface est a l'interieur de la petite
  2373. C
  2374. IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).LE.
  2375. &(RESIST(1)-RESIST(3))) THEN
  2376. KONTAC(1) = 1
  2377. KONTAC(2) = 1
  2378. KONTAC(3) = 1
  2379. KONTAC(4) = 1
  2380. ENDIF
  2381. VARF(1) = SIGHP(1)
  2382. VARF(2) = SIGHP(2)
  2383. VARF(3) = EPSI(1)
  2384. VARF(4) = EPSI(2)
  2385. VARF(5) = CPHI - 1.D0
  2386. VARF(6) = SPHI
  2387. VARF(7) = KONTAC(1)
  2388. VARF(8) = KONTAC(2)
  2389. VARF(9) = KONTAC(3)
  2390. VARF(10) = KONTAC(4)
  2391. VARF(11) = ICAS
  2392. VARF(12) = ICASB
  2393. VARF(13) = GAMBDA(ICAS)
  2394. VARF(14) = GAMBDA(ICASB)
  2395. C=====================================================
  2396. C FIN DE LA ROUTINE DU MODELE
  2397. C======================================================
  2398. RETURN
  2399. END
  2400.  
  2401.  
  2402.  
  2403.  
  2404.  
  2405.  
  2406.  
  2407.  
  2408.  
  2409.  
  2410.  

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