Sources Esope | Cast3M

ccoinc
C CCOINC    SOURCE    FANDEUR   22/05/02    21:15:03     11359          
      SUBROUTINE CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,
     &  IB,IGAU,NBPGAU,ecou,necou,iecou)
C ECOINC    SOURCE    AM        00/10/05    21:18:26     3966
c      SUBROUTINE ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
c     . N2PTEL,var0,bid,bid,XMAT,PRECIS,WORK2,WORK,TRAC,
c     . SIGF,varf,DEFP,KERRE,MFR1,IB,IGAU,NSTRS1,EPAIST,MELE,NPINT,
c     . NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
c     .                           ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C---------------------------------------------------------------------
C               ECOULEMENT PLASTIQUE POUR UN POINT
C                       D 'APRES INCA
C---------------------------------------------------------------------
C
C      EN ENTREE :
C
C                  SIG0       CONTRAINTES AU DEBUT DU PAS
C                  DEPST      INCREMENT DE DEFORMATIONS TOTALES
C                               ( THERMIQUE ENLEVEE )
C                  var0     VARIABLES INTERNES DEDUT DU PAS
C                  bid     VARIABLES EXTERNES DEBUT DU PAS
C                  VAREXF     VARIABLES EXTERNES FIN DU PAS
C                  XMAT       COEFFICIENTS DU MATERIAU
C                  PRECIS     PRECISION POUR ITERATIONS INTERNES
C                  WORK      DES CARACTERISTIQUES
C                  TRAC       COURBE DE TRACTION
C                  MFR1        INDICE DE FORMULATION
C                  NSTRS1      NOMBRE DE CONTRAINTES CA2000
C                  INPLAS     NUMERO DU MODELE DE PLASTICITE
*                  DDAUX = MATRICE DE HOOKE ELASTIQUE
*                  CMATE = NOM DU MATERIAU
*                  VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
*                  VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
*                  N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
*                  N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
*                  IFOU  = OPTION DE CALCUL
*                  IB    = NUMERO DE L ELEMENT COURANT
*                  IGAU  = NUMERO DU POINT COURANT
*                  EPAIST= EPAISSEUR
*                  NBPGAU= NBRE DE POINTS DE GAUSS
*                  MELE  = NUMERO DE L ELEMENT FINI
*                  NPINT = NBRE DE POINTS D INTEGRATION
*                  NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
*                  NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
*                  SECT  = SECTION
*                  LHOOK = TAILLE DE LA MATRICE DE HOOKE
*                  TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
*                  UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE
C
C     EN SORTIE :
C
C                  SIGF        CONTRAINTES A LA FIN DU PAS
C                  varf      VARIABLES INTERNES FIN DU PAS
C                  DEFP        INCR. DE DEFORMATIONS PLASTIQUES
C                  KERRE       CODE D'ERREUR
C                   = 0  SI TOUT OK
C                   = 99 SI FORMULATION NON DISPONIBLE
C    EN PLASTICITE
C                   = 1  SI DEPS EST NEGATIF
C                   = 2  SI NOMBRE MAX D'ITERATIONS INTERNES DEPASSE
C    EN FLUAGE
C                   = 3  DIMINUER LE PAS ( FLUAGE RUNGE )
C                   = 4  DEPS EST NEGATIF
C                   = 5  PAS DE CONVERGENCE INTERNE ( ANCIEN NSTOP=0 )
C                   = 6  MATRICE SINGULIERE DANS CHAFLU
C    EN PLUS
C                   = 7  PROBLEME DANS LES CARACT DU TUYAU
C                   = 49 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
C                   = 51 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
C                   = 52 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
C                   = 53 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
C                   = 75 PB AVEC LA COURBE DE TRACTION
C
C-----------------------------------------------------------------------
C      VARIABLES PASSEES PAR LES COMMON ECOU ET NECOU
C
C  IFOUR     INDICE DU TYPE DE PROBLEME
C            -2  CONTRAINTES PLANES
C            -1  DEFORMATIONS PLANES
C             0
C             N  SERIE DE FOURIER
C  IMAPLA    INDICE DE MATERIAU PLASTIQUE
C            0  MATERIAU ELASTIQUE
C            4  MODELE DE CHABOCHE
C            5  MODELE DE DRUCKER-PRAGER
C            7  MODELE DE ROUSSELIER
C  ITYP      TYPE DE FORMULATION MECANIQUE
C       ITYP=1   CAS DES ELEMENTS MASSIFS
C       ITYP=2   CAS DES COQUES
C       ITYP=3   CAS DES MEMBRANES
C       ITYP=4   CAS DES CABLES ET DES BARRES
C       ITYP=5   CAS QUELCONQUE
C       ITYP=6   CAS DES CONTRAINTES PLANES
C       ITYP=7   CAS DES COQUES A NU=0. OU CONTRAINTES PLANES
C       ITYP=8   CAS DES MEMBRANES A NU=0. OU CONTRAINTES PLANES                 C       ITYP=9   CAS DES COQUES EPAISSES
C       ITYP=10  CAS DES JOINTS
C       ITYP=11  CAS DES POUTRES
C       ITYP=12  CAS DES TUYAUX
C       ITYP=13  CAS DES COQUES AVEC CISAILLEMENT TRANSVERSE
C  IBI       1 SI ERREUR DANS TRACTI , 0 SINON
C  IPLAST    1 SI ON A PLASTIFIE , 0 SINON
C  ICINE  = 1 ECROUISSAGE CINEMATIQUE  ( CHABOCHE COMPRIS )
C  JFLUAG = 1 ON FLUE AVEC SIGMA
C  JFLUAG = 2 ON FLUE AVEC (SIG-X)
C  LFLUAG = 0 ON ECROUIT EN CAS DE FLUAGE
C  LFLUAG = 1 ON N'ECROUIT PAS EN CAS DE FLUAGE
C  JNTRIN = 0 LE TEMPS INTRINSEQUE EST LE TEMPS REEL
C  JNTRIN = 1 ON EVOLUE LE TEMPS INTRINSEQUE EN PLASTICITE ET FLUAGE
C  JNTRIN = 2 ON N'EVOLUE LE TEMPS INTRINSEQUE QU'EN FLUAGE
C  JNTRIN = 3 ON EST EN PLASTICITE ISOCHRONE
C
C  TETI = TEMPERATURE AU DEBUT DU PAS
C  TET  = TEMPERATURE A LA FIN DU PAS
C-----------------------------------------------------------------------
 
-INC PPARAM
-INC CCOPTIO
-INC DECHE
*  Commun ECOU: sert de fourre-tout pour les tableaux
*
      SEGMENT ECOU
***     COMMON/ECOU/TEST,ALFAH,
       REAL*8 TEST, ALFAH,
     1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
     2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
     1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
     2 SIPLAD(6),DSIGP0(6),TET,TETI
      ENDSEGMENT
 
C      COMMON/ECOU/TEST,ALFAH,
C     1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
C     2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
C     1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
C     2 SIPLAD(6),DSIGP0(6),TET,TETI
C
      SEGMENT IECOU
*      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
       INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
     1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
     2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
     3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
     4  icow32,icow33,NSTRS1,MFR1,NBGMAT,NELMAT,icow38,
C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
     5  icow39,icow40,icow41,icow42,icow43,icow44
C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
        INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
     .          icow51,icow52,icow53,icow54,icow55,icow56
     .          icow57,icow58
      ENDSEGMENT
 
*
*  Commun NECOU utilisé dans ECOINC
*
      SEGMENT NECOU
*      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
       INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
     . ITYP,IFOURB,IFLUAG,
     . ICINE,ITHER,IFLUPL,ICYCL,IBI,
     . JFLUAG,LEGAUS,LFLUAG,
     . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
      ENDSEGMENT
 
 
C      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
C     . ITYP,IFOURB,IFLUAG,
C     . ICINE,ITHER,IFLUPL,ICYCL,IBI,
C     . JFLUAG,LEGAUS,LFLUAG,
C     . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
C
*
      SEGMENT WRK2
        REAL*8 TRAC(LTRAC)
      ENDSEGMENT
*
      SEGMENT WRK3
        REAL*8 WORK(LW),WORK2(LW2)
      ENDSEGMENT
 
      REAL*8   DDOT
      EXTERNAL DDOT
*
      DIMENSION SIGMA(6),DSIGMA(6),SPHER(6),AUXIL(6),COEF(40)
      DIMENSION DIV(7),SIGFIN(6),DEFPLA(6)
      DIMENSION TABID(6),TABID2(6)
      REAL*8 CRIGI(12)
      REAL*8 EI(1)
C ZZZZZZZZZZZZZZZZZZZZZZZ
C    DIMENSIONS A REVOIR
C ZZZZZZZZZZZZZZZZZZZZZ
      DIMENSION DHOOK(1),SIG(130),EPS(130)
      DIMENSION ORMAT(1),ANORM(1)
      DIMENSION DSIGZE(6),DETFNO(1),NNNAA(13)
      DATA ITMAX/15/
      DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
      DATA A,B,C,D/.577350269D0,.7071067814D0,.4082482904D0,
     . -0.8164965808D0/
      DATA A1/1.D0/
      DATA A2/.5D0/
      DATA A3/3.D0/
      DATA COEF/0.D0,1.5D0,1.5D0,3.D0,3.D0,3.D0,0.5D0,1.5D0,3.D0,0.5D0,
     . 1.5D0,3.D0,0.D0,0.D0,1.D0,0.D0,0.D0,0.D0,1.D0,
     . 1.D0,1.D0,2.D0,2.D0,2.D0,0.5D0,1.5D0,0.D0,3.D0,
     . 1.D0,0.D0,0.D0,1.D0,1.D0,1.D0,0.5D0,1.5D0,0.D0,3.D0,3.D0,3.D0/
      DATA XRF/0.0001D0/
      DATA NNNAA/6,6,3,3,6,4,6,1,6,3,6,6,6/
C-----------------------------------------------------------------------
C         CONVENTION DE REMPLISSAGE DES MEMOIRES
C-----------------------------------------------------------------------
C
C     XMAT(1)    MODULE D'YOUNG
C     XMAT(2)    COEFFICIENT DE POISSON
C
C     TRAC(1 A 2*NCOURB) COURBE DE TRACTION
C     WORK(  " +1) ALFAH POUR COQUES PLASTICITE GLOBALE
C     WORK(  " +..) DONNEES POUR CRITERE POUTRES GLOBALES
C
C    MODELE ISOTROPE
C            var0(1)  EPS*
C
C    MODELE CINEMATIQUE LINEAIRE
C            var0(1)  EPS*
C            var0(2) A var0(1+IBOU)  DEPLACEMENT DE LA SPHERE
C
C    MODELE CHABOCHE
C            XMAT(5) ....      COEFFICIENTS A,C,...
C            var0(1)  EPS*
C            var0(2) A var0(1+IBOU) DEPLACEMENT DE LA SPHERE 1
C            var0(2+IBOU) A var0(1+2*IBOU)  "    "  "   "    2
C            ICENT2 = 1 SI ON A 2 CENTRES
C
C    MODELE DRUCKER-PRAGER
C            XMAT(5) .... XMAT(13) = LES CONSTANTES DU MODELE
C            var0(1)  EPS*
C
C    MODELE ROUSSELIER
C
C    MODELE DE CYCLAGE
C
C    MODELE A TEMPS INTRINSEQUE ( FLUAGE ET PLASTICITE ISOCHRONE )
C            var0(.)  TIMEXI   TEMPS INTRINSEQUE DE DEBUT DE PAS
C
C--------------------------------------------------------------------
C                     REMPLISSAGE
C-----------------------------------------------------------------------
      YUNG=XMAT(1)
      XNU =XMAT(2)
C
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
C    REMPLISSAGE A ACTUALISER SELON LES MODELES
CZZZZZZZZZZZZZZZZZZZZZZZZZZZ
CZZZZZZZZZZZZZZZZZZZZZZ
C      VARIABLES A RECUPERER
CZZZZZZZZZZZZZZZZZZZZZZ
C  ORMAT  MATERIAU ORTHOTROPE      DANS XMAT
C  ANORM    A VOIR         DANS XMAT OU DANS VARIN
C  EPENT    DANS VARIN
C  VECPRO,VALPRO  DANS XMAT
C  COVNMS,CVNMSD  DANS XMAT ( SELON LES CAS )
C
C  IT    DANS VAREXT
C  EPSFLU DANS VARINT
C  SIG,EPS DANS XMAT
C   DETFNO  DANS VARIN ????
C  DSIGZE DANS VARIN  ( POUR FLUAGE RELAX )
C  SIPLAD DANS VARIN  ( POUR FLUAGE RELAX  )  ...
C  ... ( CE SONT LES DEFORMATIONS OU CONTRAINTES (A VOIR) PLASTIQUES
C                            AU DEBUT DU PAS )
C  TEMPS , HPAS DANS VAREXT
C  TET,TETI DANS VAREXT
C
      EPSM1=var0(1)
      TIMEXI=var0(1)
      DPSM1=var0(1)
      DPSM2=var0(1)
      EPENT=var0(1)
      EPSFLU=var0(1)
      DETFNO(1)=var0(1)
      DSIGZE(1)=var0(1)
      TEMPS0=bid(1)
      IT=nint(bid(3))
      TEMPS=bid(1)
      TETI=bid(2)
      TET =bid(2)
      DO I=1,NCOURB
        SIG(I)=TRAC(2*I-1)
        EPS(I)=TRAC(2*I)
      ENDDO
      ORMAT(1)=XMAT(1)
      DHOOK(1)=XMAT(1)
C----------------------------------------------------------------------
C                       INITIALISATIONS
C----------------------------------------------------------------------
      KERRE=0
      JA=1
      JC=1
      IA=1
C
C  PETIT TEST SUR NU POUR CERTAINS CAS
C
      IF(MFR1.EQ.3.AND.IFOURB.EQ.-2.AND.XNU.NE.0.D0) THEN
        KERRE=38
        RETURN
      ENDIF
CZZZZZZZZZZZZZ
C  PROVISOIRE
CZZZZZZZZZZZZ
      ANORM(1)=XMAT(5)
      ICENT2=0
      IF(INPLAS.EQ.12.OR.INPLAS.EQ.13) ICENT2=1
      IF(INPLAS.EQ.7) NUMCHA=1
      IF(INPLAS.EQ.11) NUMCHA=2
      IF(INPLAS.EQ.12) NUMCHA=3
      IF(INPLAS.EQ.13) NUMCHA=4
C
      TEST=0.5D00*PRECIS
      HPAS=TEMPS-TEMPS0
      MCOD=1
 
 
C cas particulier pour elastique non-lineaire equiplas
 
        if(INPLAS.EQ.87) THEN
             EPST=0.D0
             SIG0(1)=0.D0
             DEPST(1)=DEPST(1) + VAR0(2)
             EPSM1 =0.D0
       ENDIF
*
*   CALCUL DE DSIGT
*
      CALL CALSIG(DEPST,DDAUX,NSTRS1,CMATE,VALMAT,VALCAR,
     1        N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,
     2      NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
     3    XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
*
      IF(IRTD.NE.1) THEN
         KERRE=69
         GOTO 1000
      ENDIF
*
*    TRAITEMENT DES COQ2 ET MASSIF 2D EN CAS DE MATERIAU
*    UNIDIRECTIONNEL
*
*      LES VARIABLES INTERNES SONT DANS LE REPERE UNIDIRECTIONNEL
*      ON SE LIMITE AU CAS AXISYMETRIQUE ?
*
            IF (CMATE.EQ.'UNIDIREC'.AND.INPLAS.NE.0) THEN
              IF(MELE.EQ.44.OR.(MFR1.EQ.1.AND.IFOURB.LE.0)) THEN
                 APHI=0.D0
*
*                   CAS MASSIF : ON AJOUTE L'ANGLE DU REPERE
*                   DE L'ELEMENT AVEC LE REPERE GLOBAL
*
                 IF(MFR1.EQ.1) APHI=ATAN2(TXR(2,1),TXR(1,1))
                 DO 1996 I=1,NSTRS1
                    TABID(I)=SIG0(I)
                    TABID2(I)=DSIGT(I)
 1996            CONTINUE
                 ANG = ATAN2(XMAT(4),XMAT(3))  + APHI
                 CALL CHREP2(TABID,SIG0,ANG,NSTRS1,MFR1,1,KERRE)
                 CALL CHREP2(TABID2,DSIGT,ANG,NSTRS1,MFR1,1,KERRE)
                 IF(KERRE.NE.0) RETURN
               ELSEIF(MFR1.EQ.1.AND.IFOURB.EQ.2) THEN
                 DO 996 I=1,NSTRS1
                    TABID(I)=SIG0(I)
                    TABID2(I)=DSIGT(I)
 996             CONTINUE
                 CALL CHREP3(TABID,SIG0,XMAT,TXR,NSTRS1,1,1,KERRE)
                 CALL CHREP3(TABID2,DSIGT,XMAT,TXR,NSTRS1,1,1,KERRE)
 
              ENDIF
            ENDIF
*
      CALL VISAVI(SIG0,DSIGT,var0,SIGMA,DSIGMA,SPHER,AUXIL,
     .            SIGF,DEFP,varf,SIGFIN,DEFPLA,
     .   DSIGZE,ICENT2,MCOD,IBOU,MFR1,NSTRS1,WORK,CMATE,ecou,necou)
      IF(ITYP.EQ.0) THEN
      KERRE=99
      RETURN
      ENDIF
C-----------------------------------------------------------------------
      EI(1)=YUNG
      UNSYG=1.D00/YUNG
      U5SNU=1.5D00/(1.D00+XNU)
      U5DMU=U5SNU*YUNG
      SREF=YUNG*XRF
      IPLAST=0
      LCGDF=36
      LPLUS=6
      ITER=1
      LAPOIN=0
C
C  CAS DES COQUES EN GLOBAL - ON RECUPERE LE ALFAH
C
      ALFAH=1.D0
      IF(ITYP.EQ.2) ALFAH=WORK(2)**2
      IF(ITYP.EQ.7) ALFAH=WORK(2)**2
      UNALF=0.D0
      IF(ALFAH.GE.1.D-12) UNALF=1.D0/ALFAH
C
C  CAS DES BARRES ET DES CABLES
C
      IF(ITYP.EQ.4) THEN
      DIV(1)=1.D0
      DIV(2)=1.D0
      DIV(3)=1.D0/WORK(1)
      ENDIF
 
C
C  CAS DES POUTRES
C
      IF(ITYP.NE.11) GO TO 841
      DIV(1)=1.D0/WORK(4)
      DIV(2)=1.D0
      DIV(3)=1.D0
      DIV(4)=WORK(10)/WORK(1)
      DIV(5)=WORK(11)/WORK(2)
      DIV(6)=WORK(12)/WORK(3)
      IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(WORK(1)*WORK(4))
      IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(WORK(2)*WORK(4))
      IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(WORK(3)*WORK(4))
      GO TO 761
 841  CONTINUE
C
C  CAS DES TUYAUX
C
      IF(ITYP.NE.12) GO TO 842
      EPAIS=WORK(1)
      REXT=WORK(2)
      RMOY=REXT-EPAIS*0.5D0
      RACO=WORK(3)
      GAM=1.D0
      XK=1.D0
      IF(RACO.EQ.0.D0) GO TO 765
      XLAM=RMOY*RMOY/EPAIS/RACO
      XK=1.65D0*XLAM
      IF(XK.LT.1.D0) XK=1.D0
      GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
      IF(GAM.LT.1.D0) GAM=1.D0
 765  CONTINUE
C
C     NB 23/09/98
C     VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
C     CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
C     CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
C     DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
C     DUE A LA PRESSION )
C     POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
C     DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
C
C
      DIV(1)=1.D0
      DIV(2)=1.D0
      DIV(3)=1.D0
      DIV(4)=R33
      DIV(5)=PI4*GAM
      DIV(6)=DIV(5)
      DIV(7)=R22*0.5D0
      IF(IDIM.EQ.2) THEN
        PRES1=WORK(6)
        CISA1=WORK(7)
        IXCAR1=12
        IDEB1=8
      ELSE IF(IDIM.EQ.3) THEN
        PRES1=WORK(7)
        CISA1=WORK(8)
        IXCAR1=13
        IDEB1=9
      ENDIF
C
      JDIV1=2
      DO IBA=IDEB1,IXCAR1
        JDIV1=JDIV1+1
        VCAR1=WORK(IBA)
        IF (VCAR1.NE.-1.D0) DIV(JDIV1)=WORK(IBA)
      ENDDO
C
C     NB 23/09/98
C     TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
C     1.D0 DE DIV(3)
C
      DIV(1) = DIV(3)
      DIV(3)=1.D0
C
      VX=WORK(4)
      VY=WORK(5)
      VZ=WORK(6)
      CALL TUYCAR(WORK,CISA1,VX,VY,VZ,KERRE,2)
      IF (KERRE.NE.0) THEN
        KERRE=7
        RETURN
      ENDIF
C
C     NB 23/09/98
C     DIVISION DE DIV(5) ET DIV(6) PAR XK
C     CAR TUYCAR SORT LES INERTIES MODIFIEES
C     POUR LE CALCUL DES DEFORMATIONS PAR EPSIG
C
      DIV(5)=DIV(5)/XK
      DIV(6)=DIV(6)/XK
C
      DIV(1)=DIV(1)/WORK(4)
      DIV(4)=DIV(4)*RMOY/WORK(1)
      DIV(5)=DIV(5)*RMOY/WORK(2)
      DIV(6)=DIV(6)*RMOY/WORK(3)
761   CONTINUE
      E(1)=YUNG
      E(2)=0.D0
      E(3)=0.D0
      E(4)=YUNG*1.5D0/(1.D0+XNU)
      E(5)=YUNG
      E(6)=YUNG
  842 CONTINUE
C
      IF(ICINE.EQ.0.OR.JFLUAG.EQ.1) GO TO 204
C
C       ON EST EN CINEMATIQUE ( PLASTIQUE OU FLUAGE )
C       DANS CE CAS ON FLUE AVEC SIGMA-ALPHA QUE L'ON CALCULE
C
      DO IBA=1,IBOU
        SIGMA(IBA)=SIGMA(IBA)-SPHER(IBA)
      ENDDO
 204  CONTINUE
C
      IF(JNTRIN.EQ.0) GO TO 830
      TIMEXF=TIMEXI
      GO TO 831
830   TIMEXI=TEMPS-HPAS
      TIMEXF=TEMPS
831   CONTINUE
      IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) GO TO 844
      DO IBA=1,IBOU
      SIGMA(IBA)=SIGMA(IBA)*DIV(IBA)
      IF(ICINE.EQ.0) GO TO 845
      IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 845
      SPHER(IBA)=SPHER(IBA)*DIV(IBA)
845   CONTINUE
      DSIGMA(IBA)=DSIGMA(IBA)*DIV(IBA)
      ENDDO
844   CONTINUE
      DO IBA=1,IBOU
        STOT(IBA)=SIGMA(IBA)+DSIGMA(IBA)
      ENDDO
C----------------------------------------------------------------------
C               CALCUL DE LA LIMITE ELASTIQUE
C----------------------------------------------------------------------
      IF(LFLUAG.EQ.1) GO TO 261
      IF(IMAPLA.NE.4) GO TO 262
      BPSTAR=EPSM1
      ICOD=1
      CALL CHALIM(BPSTAR,SELAS,XMAT,TET,ICOD,
     . BID,BID,BID,BID,BID1,BID2,BI3,BI4,BI5,BI6,IBID,IBID,NUMCHA)
      GO TO 261
  262 IF(IMAPLA.NE.5) GO TO 263
*                     REMPLACEMENT  XMAT(7) PAR XMAT(12) AM  8/3/90
*                     TEST SELON EPSM1                   AM 28/1/91
      IF(EPSM1.EQ.0.D0) THEN
      SELAS = XMAT(12)
      ELSE
        SELAS = XMAT(7) + EPSM1 * XMAT(13)
*
*                     AM  24/5/93  TEST SUR SELAS
*
        IF( SELAS.LT.0.D0) THEN
          SELAS = 0.D0
        ENDIF
*
      ENDIF
      GO TO 261
  263 CONTINUE
      EPSTAR=EPSM1
      IF(ICINE.EQ.1) EPSTAR=0.D0
      CALL TRACTI(SELAS,EPSTAR,SIG,EPS,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        GOTO 1000
      ENDIF
*
261   CONTINUE
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
C   A VOIR    CE QU'IL Y A DANS ANORM
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
      IF(IMAPLA.EQ.7) COVNMS(1)=ANORM(2*JC-1)
      IF(IMAPLA.EQ.7.AND.IT.EQ.1) ANORM(2*JC)=1.D-20
*
*      SI MATERIAU DRUCKER PRAGER ON CHERCHE LE CRITERE
*               AVEC LEQUEL ON DOIT FAIRE LA PROJECTION ET LE CRITERE
      IXMAT=5
      IF(IMAPLA.EQ.5.AND.EPSM1.EQ.0.D0) IXMAT=10
      CALL CKRIT(IMAPLA,STOT,ITYP,XMAT(IXMAT),ALFAH,COVNMS,XINV,SSTAR)
      SJ1=XINV(1)
      SJ2=XINV(2)
      IF(IMAPLA.EQ.0) GO TO 3
      IF(JFLUAG.NE.0) GO TO 4
C---------------------------------------------------------------------
C          A T'ON DEPASSE LA LIMITE ELASTIQUE
C---------------------------------------------------------------------
      PETI=1.1D00*TEST*SSTAR
      CALL EPSPRE(SSTAR,SELAS,PETI,ITRY)
      IF(ITRY.EQ.0.AND.SSTAR.GT.SELAS) GO TO 4
C----------------------------------------------------------------------
C         ON N'A PAS PLASTIFIE
C----------------------------------------------------------------------
    3 CONTINUE
      IF(ITYP.EQ.11.OR.ITYP.EQ.12.OR.ITYP.EQ.4) THEN
      DO IBA=1,IBOU
        IF(ICINE.NE.0)  SPHER(IBA)=SPHER(IBA)/DIV(IBA)
        STOT(IBA)=STOT(IBA)/DIV(IBA)
      ENDDO
      ENDIF
      DO IBA=1,IBOU
        SIGFIN(IBA)=STOT(IBA)
        DEFPLA(IBA)=0.D0
        DSIGMA(IBA)=0.D0
      ENDDO
      IF(INPLAS.EQ.87) THEN
            VARF(2)=DEPST(1)
      ENDIF
      STARF=SSTAR
      EPST=EPSM1
      GO TO 31
C----------------------------------------------------------------------
C                ON A PLASTIFIE
C----------------------------------------------------------------------
 4    CONTINUE
      IPLAST=1
      PENTE=0.D0
      SLOPE=0.D0
      DO IBA=1,IBOU
        W1(IBA)=SIGMA(IBA)
      ENDDO
      CALL CKRIT(IMAPLA,W1,ITYP,XMAT(5),ALFAH,COVNMS,XINV,S0)
      EPSTAR=EPSM1
C
C    EN FLUAGE SI ON LA VITESSE DE FLUAGE NE DEPEND QUE
C    DU EPSILON EQUIVALENT DE FLUAGE CUMULE ON VA LE LIRE DANS EPSFLU
C
      IF(JFLUAG.NE.0.AND.IFLUPL.EQ.1) EPSTAR=EPSFLU
      EPSIN=EPSTAR
      SEL=0.D0
      SPLA=1.D0
      IF(JFLUAG.EQ.0) THEN
        CALL SIGELP(SIGMA,DSIGMA,SIGEL,DSIGP,STOT,PETI,
     .       ITYP,SEL,SPLA,IBOU,S0,SELAS,XMAT(5),COVNMS,ALFAH,
     .       IMAPLA,SSTAR)
        CALL SHIFTD(SIGEL,DALPHA,IBOU)
      ELSE
        DO IBA=1,IBOU
          SIGEL(IBA)=SIGMA(IBA)+SEL*DSIGMA(IBA)
          DALPHA(IBA)=SIGEL(IBA)
          DSIGP(IBA)=SPLA*DSIGMA(IBA)
        ENDDO
      ENDIF
      DTIMEX=SPLA*HPAS
      IF(JNTRIN.EQ.1.OR.JNTRIN.EQ.3) TIMEXF=TIMEXI+DTIMEX
C
C           CALCUL DES PENTES
C
      IF(ABS(SPLA).LT.0.95D00) IELPLA=0
      IF(ICYCL.NE.1) GO TO 71
C
C            CAS DES MODELES DE CYCLAGE
C
      CALL NORMAL(A1,A2,A3,SIGEL,W1,ALFAH,SELAS,IBOU,ITYP)
CZZZZZZZZZZZZZZZZZZZZZZ
C    ON RECUPERE LA NORMALE DE LA DERNIERE SORTIE
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
      DO IBA=1,IBOU
        W2(IBA)=ANORM(IBA)
      ENDDO
C
C   CALCUL DU PRODUIT SCALAIRE DE LA NORMALE AU POINT OU ON SORT
C   AVEC LA DERNIERE NORMALE OU ON EST SORTI
C
      X=DDOT(IBOU,W1,1,W2,1)
C                          ON STOCKE LA NORMALE
      DO IBA=1,IBOU
        ANORM(IBA)=W1(IBA)
      ENDDO
CZZZZZZZZZZZZZZZZZZZZZZZ
C   IL FAUDRA LA STOCKER DANS varf AU LIEU DE ANORM
CZZZZZZZZZZZZZZZZZZZZZZZZZ
C
C           CALCUL DU EPSI AVEC QUOI CALCULER LA PENTE
C
      EPSEN=0.5D00*(X+1.D00)*EPENT
      EPSIN=EPSEN
   71 CONTINUE
      IF(JFLUAG.EQ.0) GO TO 40
      IF(IMAPLA.EQ.4) GO TO 5
C
C         INITIALISATIONS POUR LE FLUAGE
C         QUEL EST LE EPSILON CUMULE DE FLUAGE
C
      SLOPE=0.D0
      PENTE=0.D0
      IF(ICINE.EQ.0) GO TO 5
      IF(JFLUAG.EQ.2) GO TO 40
C
C      CAS CINE + FLUAGE : CALCUL DE LA PENTE A LA COURBE DE TRACTION
C
      IF(ICINE.EQ.2) EPSIN=EPS(NCOURB)
      CALL TRACTI(PENTE,EPSIN,SIG,EPS,NCOURB,1,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        GOTO 1000
      ENDIF
*
      GO TO 5
   40 CONTINUE
      IF(IMAPLA.EQ.5.OR.IMAPLA.EQ.4) GO TO 5
C
C CALCUL DE LA PENTE DE LA COURBE DE TRACTION AU POINT X-EPSTAR
C
      SLOPE=0.D0
      CALL TRACTI(PENTE,EPSIN,SIG,EPS,NCOURB,1,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        GOTO 1000
      ENDIF
*
      IF(ICINE.EQ.0) GO TO 5
 6    CONTINUE
      SLOPE=PENTE
      PENTE=0.
      PANTIN=SLOPE
      IF(ICINE.EQ.1) GO TO 5
      EPSIN=EPS(NCOURB)
      CALL TRACTI(PANTIN,EPSIN,SIG,EPS,NCOURB,1,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        GOTO 1000
      ENDIF
*
      PENTE=SLOPE-PANTIN
      SLOPE=PANTIN
 5    CONTINUE
      IF(IMAPLA.NE.4) GO TO 5621
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C                       MODELE CHABOCHE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      IF(JFLUAG.EQ.0)
     .  CALL CHABOK(YUNG,XNU,IA,EI,
     .  XMAT,SPHER,JA,IBOU,SI,DEPS,EPST,EPSTAR,WORK2,KERRE,SN,
     .  AUXIL,NUMCHA,ecou,necou)
      IF(JFLUAG.NE.0)
     .  CALL CHAFLU(YUNG,XNU,IA,EI,SSTAR,
     1  XMAT,SPHER,IBOU,SI,DEPS,EPST,EPSTAR,WORK2,
     2  AUXIL,DPSM1,DPSM2,KERRE,NUMCHA,ecou,necou)
      IF(KERRE.NE.0) RETURN
      IF(JFLUAG.NE.0.AND.IMAPLA.EQ.4) GO TO 689
      IF(IMAPLA.EQ.4) GO TO 570
 5621 CONTINUE
      IF(IMAPLA.NE.5) GO TO 9997
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C                MODELE DRUCKER-PRAGER  -  PRELIMINAIRES
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     ON EST DANS LE CAS DU MATERIAU DRUCKER-PRAGER.ON VA FAIRE UN
C     TEST POUR SAVOIR SI L'ON DOIT PROJETER AU SOMMET DU CONE ET
C     EVENTUELLEMENT FAIRE CETTE PROJECTION.
C     DANS CETTE VERSION,LE TEST CONSISTE A SAVOIR SI L'ETAT DE
C     CONTRAINTES CALCULE ELASTIQUEMENT SE TROUVE D'UN COTE OU DE
C     L'AUTRE D'UN PLAN ORTHOGONAL A L'AXE ET PASSANT PAR LE SOMMET
C     DU CONE,PUIS A SAVOIR SI L'ON EST A L'INTERIEUR OU A
C     L'EXTERIEUR DU CONE DES NORMALES AU CRITERE DE DRUCKER.
C     ON CALCULE LE I1 QUI DELIMITE LES DEUX REGIONS ET ON LE
C     COMPARE AVEC LE PREMIER INVARIANT DU TENSEUR CALCULE ELASTIQUEMENT
C
C
C     SNN=XMAT(7)+XMAT(13)*EPSTAR
*
*                     AM  24/5/93  TEST SUR SNN
*
*     IF( SNN*XMAT(7).LT.0.D0) THEN
*       SNN=0.D0
*       XMAT(13)=0.D0
*     ENDIF
*
C
C     MILL  17/3/93
C     SI XMAT(5)=0. PAS DE TEST PAR RAPPORT AU SOMMET
C
C     IF(XMAT(5).EQ.0.D0) GO TO 99970
C
C     XI1LIM=SNN/XMAT(5)
C     IF(SJ1.LE.XI1LIM) GO TO 99970
C
C     ON TESTE ENSUITE PAR RAPPORT AU CONE DES NORMALES
C
C     TESTDR=-XMAT(9)*SJ1/(2.D0*XMAT(8))+SJ2+XI1LIM*XMAT(9)/
C    .                    (2.D0*XMAT(8)*XMAT(5))
C     IF(TESTDR.GT.0.D00)GO TO 99970
C
C     ON EST MAINTENANT DANS LE CAS OU L'ON DOIT PROJETER AU SOMMET
C
C     CALL SOMDRU(IBOU,SI,DEPS,EPST,EPSTAR,SNN,XMAT(5),YUNG,XNU,KERRE)
C     IF(KERRE.NE.0) RETURN
C     LAPOIN=1
C     GO TO 570
99970 CONTINUE
      CALL SHIFTD(DHOOK,WORK2(109),36)
      CALL PRJDRU(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,EPSTAR,ITER,
     .   SN,WORK2(109),WORK2,WORK2(37),WORK2(73),XMAT(5),YUNG,
     .   XNU,LAPOIN,KERRE,ecou,necou)
      IF(KERRE.NE.0) RETURN
      GO TO 570
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C                        MODELE ROUSSELIER
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
9997  IF(IMAPLA.EQ.7) THEN
      CALL FISSUR
C     CALL FISSUR(YUNG,XNU,U5DMU,XMAT(5),A,B,C,ANORM,
C    1 JC,SIG,EPS,SELAS,SSTAR,IBOU,JKI,PENTE,EPSTAR,EPST,ITMAX,COEF,
C    1 IA,S0,SI,DEPS,SN,IMPRI)
      GO TO 570
      ENDIF
C
      IF (IRELAX.NE.0) THEN
C
C  MODIF DU 18/3/86  ON MET SIPLAD A 0. ( AVANT ON AVAIT DEFP )
C
        DO IBA=1,IBOU
          SIPLAD(IBA)=0.D00
          DSIGP0(IBA)=DSIGZE(IBA)
        ENDDO
      ENDIF
      IF(JGRDEF.LE.1) GO TO 420
C
C       INTEGRATION EN GRANDES DEFORMATIONS D N'EST PLUS ISOTROPE
C ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
C            A VOIR|||||||||||||||||||||||||
      CALL SHIFTD(DHOOK,WORK2,36)
      RAI=DETFNO(1)
      CALL T6CDCT
C     CALL T6CDCT(CGDFNO((IA-1)*LCGDF+1),WORK2,4,W1,RAI)
      CALL PRJGDF
C     CALL PRJGDF(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,EPSTAR,
C    1 ITER,SN,TET,WORK2,WORK2(37),WORK2(73),PANTIN,TIMEXF,SIG,EPS,IA,
C    1 WORK2(109))
      CALL SHIFTD(W1,DEFPLA,6)
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
      GO TO 570
  420 CONTINUE
C----------------------------------------------------------------------
C                 ECRITURE SOUS FORME DIAGONALE
C               DIAGONALISATION DE SIGEL ET DSIGP
C----------------------------------------------------------------------
      NK=1
      CALL XYZDIA(DSIGP,SIGEL,W1,W2,A,B,C,D,ITYP,VECPRO)
      IF(IRELAX.NE.0)
     1 CALL XYZDIA(SIPLAD,DSIGP0,W1,W2,A,B,C,D,ITYP,VECPRO)
C
      GO TO (60,61,61,63,64,65,66,66,68,69,78,79,80),ITYP
C
   80 CONTINUE
C                 CONTRAINTES PLANES AVEC TOUS LES CISAILLEMENTS
C
      RAI=YUNG/(1.D0-XNU*XNU)
      E(1)=RAI*(1.D0+XNU)*0.5D0
      E(2)=RAI*(1.D0-XNU)*1.5D0
      E(3)=0.D0
      E(4)=E(2)
      E(5)=E(2)
      E(6)=E(2)
      JKI=34
      GO TO 615
C
  79  CONTINUE
C                   TUYAUX
  78  CONTINUE
C                   POUTRES
C     LE REMPLISSAGE DE E EST FAIT EN AMONT
C
      JKI=28
      GO TO 615
   69 CONTINUE
      GO TO 640
   68 CONTINUE
      GO TO 640
   66 CONTINUE
C                   COQUE OU MEMBRANE A NU =0 OU CP
C
      RAI=YUNG
      E(1)=RAI
      IF(ICINE.NE.0) E(1)=E(1)+SLOPE
      E(2)=0.D00
      E(3)=0.D00
      E(4)=E(1)*ALFAH
      E(5)=0.D00
      E(6)=0.D00
      W1(1)=DSIGP(1)/(E(1)+PENTE)
      IF(ITYP.EQ.7) THEN
        IF(ALFAH.NE.0.D0) THEN
        W1(4)=DSIGP(4)/(E(4)+PENTE)
        ELSE
        W1(4)=0.D0
        ENDIF
      ENDIF
      JKI=18
      DEPS=VNMISD(W1,ITYP,ALFAH,COVNMS)
      GO TO 640
   65 CONTINUE
C                      CONTRAINTES  PLANES
C
      RAI=YUNG/(1.D0-XNU*XNU)
      E(1)=RAI*(1.D0+XNU)*0.5D0
      E(2)=RAI*(1.D0-XNU)*1.5D0
      E(3)=0.D0
      E(4)=E(2)
      E(5)=E(3)
      E(6)=E(3)
      JKI=24
      GO TO 615
   64 CONTINUE
C                   MATER QUELCONQUE
C
      JKI=18
      NK=1
      DO IBA=1,6
        E(IBA)=VALPRO(IBA)
      ENDDO
      IF(ICINE.NE.0) THEN
        DO IBA=1,6
          E(IBA)=E(IBA)+SLOPE
        ENDDO
      ENDIF
      DO IBA=1,6
        r_z = E(IBA)+PENTE
        IF (r_z.NE.0.D00) THEN
          W1(IBA)=DSIGP(IBA)/r_z
        ENDIF
      ENDDO
      DEPS=VNMISD(W1,ITYP,ALFAH,CVNMSD)
      GO TO 640
C
   61 CONTINUE
      RAI=YUNG/(1.D0-XNU*XNU)
      E(1)=RAI*(1.D0+XNU)*0.5D0
      E(2)=RAI*(1.D0-XNU)*1.5D0
      E(3)=E(2)
      E(4)=E(1)*ALFAH
      E(5)=E(2)*ALFAH
      E(6)=E(3)*ALFAH
      JKI=6
  615 CONTINUE
      IF(ICINE.NE.0) THEN
        DO IK=1,6
          E(IK)=E(IK)+SLOPE
        ENDDO
      ENDIF
      IBO=2
      IF(ITYP.EQ.3.OR.ITYP.EQ.6) IBO=1
      IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) W1(3)=0.D0
      DO I=1,IBOU
        IF(ITYP.EQ.6.AND.I.EQ.3) GO TO 614
        W1(I)=0.D0
        IF(PENTE+E(I).EQ.0.) GO TO 614
        W1(I)=DSIGP(I)/(E(I)+PENTE)
  614   CONTINUE
      ENDDO
      DEPS=VNMISD(W1,ITYP,ALFAH,COVNMS)
      GO TO 640
C
   63 E(3)=U5DMU/U5SNU
      IF(ICINE.NE.0) E(3)=E(3)+SLOPE
      NK=3
      JKI=12
      E(1)=0.D0
      E(2)=0.D0
      E(4)=0.D0
      E(5)=0.D0
      E(6)=0.D0
      DEPS=DSIGP(3)/(E(3)+PENTE)
      if(imapla.eq.1) deps = abs(deps)
      GO TO 640
C
   60 CONTINUE
      JKI=0
      E(1)=0.
      DO I=2,6
        E(I)=U5DMU
      ENDDO
      IF(ICINE.NE.0) THEN
        DO I=1,6
          E(I)=E(I)+SLOPE
        ENDDO
      ENDIF
      EMU=PENTE+U5DMU
      RAI=YUNG
      IF(IMAPLA.EQ.5) EMU=U5DMU+3*XMAT(5)*XMAT(5)*RAI/(1.D0-2.D0*XNU)
      DEPS=(SSTAR-SELAS)/EMU
C
  640 CONTINUE
C
                  IF(JFLUAG.NE.0) GO TO 41
C-----------------------------------------------------------------------
C       PLASTICITE  - PROJECTION SUR LA SURFACE DE CHARGE
C-----------------------------------------------------------------------
      CALL PROJVM(SIG,EPS,EPST,EPSTAR,DEPS,PENTE,SN,PANTIN,
     1 SELAS,ITER,SO,SSTAR,SI,NK,IBOU,COEF,JKI,KERRE,ecou,necou)
C
      GO TO 57
C-----------------------------------------------------------------------
C                       FLUAGE
C-----------------------------------------------------------------------
   41 CONTINUE
      CALL FLUAGE(ITER,EPSTAR,S0,EPST,SSTAR,SI,DPSM1,DPSM2,
     . IBOU,DEPS,ICONV,TIMEXI,TIMEXF,YUNG,KERRE,ecou,necou )
      IF(KERRE.EQ.0) GO TO 8693
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
C   TESTER  KERRE EN SORTIE DE FLUAGE
C  ON RECUPERE AUUSI ICONV EN SORTIE
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
8693  CONTINUE
689   CONTINUE
C-----------------------------------------------------------------------
C          ON STOKE LE EPS DE FLUAGE DANS EPSFLU DANS TOUS LES CAS
C-----------------------------------------------------------------------
      EPSFLU=EPST
C           ON CALCULE LE EPSILON INELASTIQUE CUMULE
C
      EPST=EPSM1
      IF(LFLUAG.EQ.1) GO TO 414
C             ON ECROUIT LE RAYON DE LA SURFACE DE CHARGE
C
      EPST=DEPS+EPSM1
  414 CONTINUE
      IF(IMAPLA.EQ.4) GO TO 570
      IF(ICINE.EQ.0) GO TO 413
      IF(LFLUAG.EQ.1) GO TO 57
C            CAS CINEMATIQUE
C
      SLIM=SELAS
      GO TO 57
  413 CONTINUE
C         CAS ISOTROPE
C
      IF(LFLUAG.EQ.1) GO TO 57
C            ON CHERCHE LE NOUVEAU RAYON DE LA SPHERE
C
      CALL TRACTI(SF,EPST,SIG,EPS,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        GOTO 1000
      ENDIF
*
      SLIM=SF
C
  57   CONTINUE
C
C----------------------------------------------------------------------
C                         RETOUR AUX AXES X Y Z
C----------------------------------------------------------------------
      CALL DIAXYZ(ITYP,SIGT,SIGEL,VECPRO,IBO,A,B,C,B1,B2)
      IF(JFLUAG.EQ.0) GO TO 10
      IF((IT.EQ.1.AND.IRELAX.EQ.0).OR.(ICONV.NE.0.AND.IRELAX.NE.0))
     . CALL DIAXYZ(ITYP,DSIGP,STOT,VECPRO,IBO,A,B,C,B1,B2)
10    CONTINUE
C-----------------------------------------------------------------------
C                     TRAITEMENT FINAL
C-----------------------------------------------------------------------
  570 CONTINUE
      EPSM1F=EPST
      IF(ICYCL.EQ.1) EPENTF=EPSEN+DEPS
      IF(IMAPLA.NE.7) GO TO 9100
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
C     VOIR SI ON A BESOIN DE SIGT
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
      DO IBA=1,IBOU
         SIGT(IBA)=SIGT(IBA)-W1(IBA)
      ENDDO
 9100 CONTINUE
      IF(ICINE.EQ.0) GO TO 913
      IF(LFLUAG.EQ.1) GO TO 913
      IF(JFLUAG.EQ.1) GO TO 94
      IF(IMAPLA.EQ.4) GO TO 90
C----------------------------------------------------------------------
C         CAS CINEMATIQUE - CALCUL DE DALPHA
C----------------------------------------------------------------------
      Z=PANTIN*DEPS/SELAS
      IF(Z.LT.0.01D00) GO TO 910
      EZZ=1.D0-EXP(-Z)
      Z=1.D0-EZZ/Z
      EZZ=EZZ/(1.D0-Z)
      Z=Z/(1.D0-Z)
      DO IBA=1,IBOU
        DALPHA(IBA)=DALPHA(IBA)*EZZ+Z*(SIGEL(IBA)-DALPHA(IBA))
      ENDDO
      GO TO 90
  910 CONTINUE
      DO IBA=1,IBOU
        DALPHA(IBA)=Z*0.5D0*(DALPHA(IBA)+SIGEL(IBA))
      ENDDO
      GO TO 90
   94 CONTINUE
      IF(IMAPLA.EQ.4) GO TO 913
      CALL MOVCEN(PENTE,DEPS,SELAS,JA,IBOU,DALPHA,SIGMA,SPHER,SIGEL)
  90  CONTINUE
 913  CONTINUE
C----------------------------------------------------------------------
C         CAS CINEMATIQUE    COORDONNEES DU NOUVEAU CENTRE DE LA SPHERE
C----------------------------------------------------------------------
      IF(ICINE.EQ.0) GO TO 29
C
C  MODELE CHABOC  MISE A JOUR DE SPHER DANS CHABOC
C  SPHER CONTIENT LA SOMME DES DEPLACEMENTS DES SPHERES
C
       IF(IMAPLA.EQ.4) GO TO 29
      IF(LFLUAG.EQ.1.AND.JFLUAG.NE.0) GO TO 29
      DO IBA=1,IBOU
        SPHER(IBA)=SPHER(IBA)+DALPHA(IBA)
      ENDDO
   29 CONTINUE
C-----------------------------------------------------------------------
C  CALCUL DU SIGMA FINAL ET DE LA NOUVELLE LIMITE ELASTIQUE
C-----------------------------------------------------------------------
      IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) GO TO 846
      DO IBA=1,IBOU
      STOT(IBA)=STOT(IBA)/DIV(IBA)
      IF(ICINE.EQ.0) GO TO 847
      IF(LFLUAG.EQ.1.AND.JFLUAG.NE.0) GO TO 847
      SPHER(IBA)=SPHER(IBA)/DIV(IBA)
      DALPHA(IBA)=DALPHA(IBA)/DIV(IBA)
847   CONTINUE
      SIGEL(IBA)=SIGEL(IBA)/DIV(IBA)
      ENDDO
846   CONTINUE
      DO IBA=1,IBOU
        SIGFIN(IBA)=SIGEL(IBA)
      ENDDO
      STARF=SI
      IF(JFLUAG.EQ.0) SLIMF=SN
      IF(JNTRIN.NE.0) EPENTF=TIMEXF
C
      IF(DEPS.LT.0.D00) KERRE=1
C          CALCUL DU NOUVEAU SIGMAP
      DO IBA=1,IBOU
        DSIGMA(IBA)=STOT(IBA)-SIGEL(IBA)
      ENDDO
      IF(ICINE.EQ.0) GO TO 240
      IF(JFLUAG.EQ.1) GO TO 240
      IF(LFLUAG.EQ.1) GO TO 240
      DO IBA=1,IBOU
        DSIGMA(IBA)=DSIGMA(IBA)-DALPHA(IBA)
      ENDDO
  240 CONTINUE
*
      IF(ITYP.EQ.6.AND.IMAPLA.EQ.5.AND.LAPOIN.EQ.0) THEN
      DO IBA=1,IBOU
        DEFPLA(IBA)=EPSPLA(IBA)
      ENDDO
      EPST=EPSM1 + VONEPS(DEFPLA,ITYP,ALFAH,COVNMS)
      GO TO 31
      ENDIF
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
C    ATTENTION LE EPSIG NE MARCHE QUE POUR CERTAINS CAS
CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
      CALL EPSIG(DSIGMA,DEFPLA,IFOURB,YUNG,XNU,ITYP,ORMAT,WORK)
      IF(ITYP.EQ.6.AND.IMAPLA.NE.5) DEFPLA(3)=-DEFPLA(1)-DEFPLA(2)
  31  CONTINUE
C-----------------------------------------------------------------------
C                  REMPLISSAGE
C-----------------------------------------------------------------------
      varf(1)=EPST
      if(inplas.eq.87) THEN
          DO I=1,IBOU
              VARF(1+I)=DEPST(I)
         ENDDO
      endif
CZZZZZZZZZZZ
C PROVISOIRE
CZZZZZZZZZZZ
      IF(JFLUAG.EQ.1) varf(1)=EPSFLU
      IF(ICINE.EQ.0) GO TO 280
C              ON CALCULE LA VRAIE CONTRAINTE EN CINEMATIQUE
      DO 281 IBA=1,IBOU
      IF(JFLUAG.EQ.1) GO TO 284
      SIGFIN(IBA)=SIGFIN(IBA)+SPHER(IBA)
284   IF(LFLUAG.EQ.1) GO TO 281
      IF(ICENT2.NE.0) SPHER(IBA)=SPHER(IBA)-AUXIL(IBA)
  281 CONTINUE
  280 CONTINUE
*
*  MISE A 0. DES COMPOSANTES NON CALCULEES SI ITYP=8
*
      IF(ITYP.EQ.8.AND.IBOU.LT.NSTRS1) THEN
         DO 285 IBA=2,NSTRS1
            DEFPLA(IBA)=0.D0
            SIGFIN(IBA)=0.D0
              IF(ICENT2.NE.0) SPHER(IBA)=0.D0
 285     CONTINUE
      ENDIF
*
      MCOD=2
      CALL VISAVI(SIG0,DSIGT,var0,SIGMA,DSIGMA,SPHER,AUXIL,
     .            SIGF,DEFP,varf,SIGFIN,DEFPLA,
     .   DSIGZE,ICENT2,MCOD,IBOU,MFR1,NSTRS1,WORK,CMATE,ecou,necou)
C
C      RETRAITEMENT POUR LES COQ2 ET MASSIFS  EN MATERIAU
C      UNIDIRECTIONNEL
C
 
              IF (CMATE.EQ.'UNIDIREC'.AND.INPLAS.NE.0) THEN
                 IF(MELE.EQ.44.OR.(MFR1.EQ.1.AND.IFOURB.LE.0)) THEN
                  DO 1997 I=1,NSTRS1
                    TABID(I)=SIGF(I)
                    TABID2(I)=DEFP(I)
 1997             CONTINUE
                  CALL CHREP2(TABID,SIGF,-ANG,NSTRS1,MFR1,1,KERRE)
                  CALL CHREP2(TABID2,DEFP,-ANG,NSTRS1,MFR1,2,KERRE)
                  IF(KERRE.NE.0) RETURN
                 ELSEIF(MFR1.EQ.1.AND.IFOURB.EQ.2) THEN
                  DO 997 I=1,NSTRS1
                    TABID(I)=SIGF(I)
                    TABID2(I)=DEFP(I)
 997              CONTINUE
                  CALL CHREP3(TABID,SIGF,XMAT,TXR,NSTRS1,1,2,KERRE)
                  CALL CHREP3(TABID2,DEFP,XMAT,TXR,NSTRS1,2,2,KERRE)
                 ENDIF
              ENDIF
*
 1000 RETURN
      END