Télécharger la plaquette Cast3M


fr en

Télécharger betocy.eso

Retour à la liste

Numérotation des lignes : 

betocy

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

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