Sources Esope | Cast3M

consti
C CONSTI    SOURCE    PV        22/04/25    21:15:01     11344          
      SUBROUTINE CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
     1 INPLAS,MFR,DT,NSTRS,NVARI,NCOMAT,PRECAS,MSOUPA,JECHER,DTT,
     2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,
     3 NYN,NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,T0,TF,
     5 TREF,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
     7NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
C
C---------------------------------------------------------------------
C Objet: Calculer au cours d'un pas de temps DT, l'evolution des
C        variables internes a l'aide d'un schema Runge-Kutta 1.2
C ---------------------------------------------------------------------
C
C---------------------------------------------------------------------
C Entree: INPLAS type de materiau
C         MFR indice de la formulation mecanique(seulement massif ou coque
C           pour les materiaux endommageables)
C         DEPST(NSTRS) increment des deformations totales
C         SIG0(NSTRS) contraintes initiales
C         EPIN0(NSTRS) deformations viscoplastiques initiales
C         VAR0(NVARI) variables internes initiales
C         NVARI nombre de variables internes
C         YOG(NYOG) courbe du module d'Young en fonction de T°C
C         YNU(NYNU) courbe du coefficient de Poisson en fonction de T°C
C         SIGY(NSIGY) courbe de la limite elastique en fonction de T°C
C         YRHO(NYRHO) courbe de la masse volumique en fonction de T°C
C         YALFA(NYALFA) courbe du coeff de dilatation en fonction de T°C
C         YN(NYN)
C         YM(NYM)
C         YKK(NYKK)     courbes des autres coefficients caracteristiques
C         YALFA1(NYALF1)  en fonction de la T°C intervenant
C         YBETA1(NYBET1)   dans les lois d'evolution
C         YR(NYR)
C         YA(NYA)
C         YKX(NYKX) fonction k(X) tabulee en fonction de la temperature
C         NKX(NNKX) tableau de pointeurs sur les courbes de k(X)
C         XMAT(NCOMAT) materiau
C         XCAR(ICARA) caracteristiques geometriques
C         YSMAX(NYSMAX) intervient ds. le test de convergence des iter.
C         TRUC(NCOURB) tableau de travail
C         PRECIS precision relative sur SIGMA
C         MSOUPA nombre maximal de sous pas autorises
C         JECHER = 0 avancer
C                = 1 rechercher sortie avec DTT
C         IFOURB = -3 EN DEFORM. PLANES GENER.
C                  -2 EN CONTR.PLANES
C                  -1 EN DEFORM. PLANES
C                   0 EN AXISYMETRIE
C                   1 EN SERIE DE FOURIER
C                   2 EN TRIDIM
*         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
*         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
C         DD(NSTRS,NSTRS) matrice de Hooke en fonction de T
C         DDV(NSTRS,NSTRS) derivee de DD
C         DDINV(NSTRS,NSTRS) inverse de DD
C         T0 temperature a t0
C         TF temperature a t0+DT
C         TREF temperature de reference
C         DT pas de temps
C         ITHHER = 0 pas de chargement thermique et materiau constant
C                = 1 chargement thermique et materiau constant
C                = 2 chargement thermique et materiau(T)
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
C Sortie: SIGF(NSTRS) contraintes finales
C         EPINF(NSTRS) deformations viscoplastiques finales
C         VARF(NVARI) variables internes finales
C         DTT sous-increment de temps optimal (si JECHER=1)
C         TLIFE  sous-increment de temps a rupture pour materiau
C           viscoplastique endommageable
C         NSSINC nombre de sous-increments si JECHER=0
C         INV = 1 si inversion
C               0 sinon
C         KERRE = 0 si tout OK
C               &lt;> 0 si entrees incoherentes
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
       IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
*
      SEGMENT WRK0
       REAL*8 XMAT(NCXMAT)
      ENDSEGMENT
*
      SEGMENT WR00
       CHARACTER*16 TYMAT(NCXMAT)
       REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
      ENDSEGMENT
*
      SEGMENT WRK1
        REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT
*
      SEGMENT WRK5
        REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
      ENDSEGMENT
*
      SEGMENT WRK7
        REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
      ENDSEGMENT
*
      SEGMENT WRK8
        REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
        REAL*8 DDINVp(NSTRS1,NSTRS1)
      ENDSEGMENT
*
      SEGMENT WRK9
        REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
        REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
        REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
        REAL*8 SIGY(NSIGY)
        INTEGER NKX(NNKX)
      ENDSEGMENT
*
      SEGMENT WTRAV
        REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
        REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
        REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
        REAL*8 XLOC(3,3),XGLOB(3,3)
        REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
      ENDSEGMENT
*
       DIMENSION VAR(100),VAR1(100),VARP1(100),VARP2(100)
       DIMENSION CRIGI(12),VARP12(100),VAR12(100),VARP3(100)
       DIMENSION VARP4(100),VAR13(100),VARP5(100)
*
C#MC 21/01/99 : les tableaux doivent dimensionnes en fonction
C               du plus grand INFELE(16) (voir elquoi.eso)
       DIMENSION SIG(8),SIG1(8),SIG12(8),SIG13(8),SIG15(8)
       DIMENSION DSPT(8),EPSTHD(8),XX(8),SIGP5(8)
       DIMENSION EVP1(8),EVP2(8),XPM1(8),XPM2(8),EVP3(8),EVP4(8)
       DIMENSION XPM3(8),XPM4(8)
       DIMENSION SIGP1(8),SIGP2(8), SIGP3(8), SIGP4(8),EVP5(8)
       DIMENSION EPSV(8),EPSV1(8),EPSCP(8),EPSV12(8),EPSV13(8)
       DIMENSION XMAT0(12)
*
       CHARACTER*8 CMATE
       logical dtlibr,impre
*  petit hack: valma0 n'est pas defini mais on se  sert de valma0(28) dans incre2
       real*8 valma0(28)
       valma0(28)=0.d0
       precis = precas
 
 
 
 
 
C
*
        dtlibr=.TRUE.
       IF (INPLAS.EQ.29) THEN
C Test sur l'identite de toutes les listes de temperatures des coefficients
C intervenant dans les lois d'evolutions non-lineaires des variables internes
         CALL TEST(YN,NYN,YM,NYM,YKK,NYKK,YALFA1,NYALF1,YBETA1,NYBET1,
     &    YR,NYR,YA,NYA,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,ITEST)
       ENDIF
       KERRE = 0
       IF(MFR.NE.1.AND.MFR.NE.3.AND.MFR.NE.5.AND.MFR.NE.17
     &    .AND.MFR.NE.33.and.mfr.ne.31)THEN
           KERRE = 99
           RETURN
       ENDIF
*
*  AM 5/5/00   MFR = 33   : MODELES 19 A 24 pour le moment
*
       IF(MFR.EQ.33) THEN
         IF(INPLAS.LT.19.OR.INPLAS.GT.24) THEN
           KERRE = 99
           RETURN
         ENDIF
       ENDIF
*
       IF(MFR.EQ.3) THEN
       THICK = XCAR(1)
       ALFA  = XCAR(2)
       ENDIF
*        dtprem=0.D0
*        dtdeux=0.d0
        dtleft= dt
       BORNE = 2.0
       RMAX  = 1.3
       RMIN  = 0.7
       DIV   = 7.0
       FAC   = 3.0
       TLIFE = -1.D0
CCC Eloi
CCC Pour etre en harmonie avec l'appel de INCRE1 par CCONST
       FI1 = 0.D0
       FITAU = 0.D0
       TTAU = 0.D0
C
C   CALCUL DES INCREMENTS DE DEFORMATIONS
C
       IF (INPLAS.NE.29)  THEN
        CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
     1   VALCAR,N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST,
     2   NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
     3           XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
*
       IF(IRTD.NE.1) THEN
          KERRE=69
          GOTO 998
       ENDIF
*
       ENDIF
       IF(MFR.EQ.3) THEN
           DO 10 I=1,NSTRS/2
             SIG0(        I) = SIG0(        I)/THICK
             SIG0(NSTRS/2+I) = SIG0(NSTRS/2+I)*6.0D0/THICK/THICK
             IF (INPLAS.NE.29) THEN
              DSIGT(       I) = DSIGT(        I)/THICK
              DSIGT(NSTRS/2+I)= DSIGT(NSTRS/2+I)*6.0D0/THICK/THICK
             ELSE
              DEPST(       I) = DEPST(        I)
              DEPST(NSTRS/2+I)= -DEPST(NSTRS/2+I)*THICK/2
             ENDIF
10         CONTINUE
           IF(IFOURB.EQ.-2) THEN
               SIG0 (2) =0.0
               SIG0 (4) =0.0
               IF (INPLAS.NE.29) THEN
                  DSIGT(2) =0.0
                  DSIGT(4) =0.0
               ENDIF
           ENDIF
       ENDIF
C
C REMISE A ZERO DE SIG A L'EXCEPTION DU MOMENT SUIVANT Z ET DE
C   L'EFFORT SUIVANT X (MODE I DU CHARGEMENT)
C
       IF(MFR.EQ.17) THEN
       SIG0(        2) = 0.0D0
       SIG0(        3) = 0.0D0
       SIG0(        4) = 0.0D0
       SIG0(        5) = 0.0D0
       ENDIF
C
C------------------------------------------
C CONTROLE DE LA COHERENCE DES ENTREES
C------------------------------------------
       IF (DT.LT.0.0) KERRE = 414
       IF (INPLAS.EQ.63.AND.MFR.NE.1.AND.MFR.NE.31) THEN
         KERRE=99
         RETURN
       ENDIF
       IF(DT.EQ.0.0) DT = 1.e-20
       MOTERR(1:8) = ' CONST  '
       IF(INPLAS.NE.17) GO TO 20
       IF ((NVARI.NE.(6+4*NSTRS)).AND.(MFR.NE.5)) KERRE = 146
       IF ((NVARI.NE.(10+4*NSTRS)).AND.(MFR.EQ.5)) KERRE = 146
       IF (IFOURB.NE.-2.AND.NCOMAT.LT.24) KERRE = 146
       IF (IFOURB.EQ.-2.AND.NCOMAT.LT.25) KERRE = 146
       XMAX=XMAT(8)
       GO TO 30
   20  CONTINUE
 
       IF(MFR.NE.33) THEN
 
         IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT. 8)KERRE = 146
         IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT. 9)KERRE = 146
         IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
         IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
         IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
         IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.13)KERRE = 146
         IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
         IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
         IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
         IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
         IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.11)KERRE = 146
         IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.12)KERRE = 146
         IF (INPLAS.EQ.25.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
         IF (INPLAS.EQ.25.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
         IF (INPLAS.EQ.29.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
         IF (INPLAS.EQ.29.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
         IF (INPLAS.EQ.44.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
         IF (INPLAS.EQ.44.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
         IF (INPLAS.EQ.45.AND.IFOURB.NE.-2.AND.NCOMAT.LT.27)KERRE = 146
         IF (INPLAS.EQ.45.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.28)KERRE = 146
         IF (INPLAS.EQ.53.AND.IFOURB.NE.-2.AND.NCOMAT.LT.28)KERRE = 146
         IF (INPLAS.EQ.53.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.29)KERRE = 146
         IF (INPLAS.EQ.61.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
         IF (INPLAS.EQ.61.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
         IF (INPLAS.EQ.63.AND.IFOURB.NE.-2.AND.NCOMAT.LT.32)KERRE = 146
         IF (INPLAS.EQ.63.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.33)KERRE = 146
         IF (INPLAS.EQ.70.AND.IFOURB.NE.-2.AND.NCOMAT.LT.14)KERRE = 146
         IF (INPLAS.EQ.70.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.15)KERRE = 146
         IF (INPLAS.EQ.76.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
         IF (INPLAS.EQ.76.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
         IF (INPLAS.EQ.77.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
         IF (INPLAS.EQ.77.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
         IF (INPLAS.EQ.83.AND.IFOURB.NE.-2.AND.NCOMAT.LT.15)KERRE = 146
         IF (INPLAS.EQ.83.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
         IF (INPLAS.EQ.84.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
         IF (INPLAS.EQ.84.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
         IF (INPLAS.EQ.85.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
         IF (INPLAS.EQ.85.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
         IF (INPLAS.EQ.86.AND.IFOURB.NE.-2.AND.NCOMAT.LT.17)KERRE = 146
         IF (INPLAS.EQ.86.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.18)KERRE = 146
         IF (INPLAS.EQ.102.AND.IFOURB.NE.-2.AND.NCOMAT.LT.25)KERRE = 146
         IF (INPLAS.EQ.102.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.26)KERRE = 146
 
       ELSE
*
*        cas MFR=33
*
 
         IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
         IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
         IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
         IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
         IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
         IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
         IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
         IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.22)KERRE = 146
         IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.24)KERRE = 146
         IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.25)KERRE = 146
         IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
         IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
 
 
       ENDIF
 
 
       IF(IFOURB.EQ.1) THEN
          KERRE = 194
          MOTERR(1:8) = 'FLUAGE'
       ENDIF
       XMAX=XMAT(5)
       IF((INPLAS.EQ.25).OR.(INPLAS.EQ.53)) XMAX=XMAT(7)
       IF((INPLAS.EQ.76).OR.(INPLAS.EQ.77)) XMAX=XMAT(7)
       IF(INPLAS.EQ.70)   XMAX =XMAT(1)*1.D-3
       IF(INPLAS.EQ.29) THEN
          CALL DERTRA(NYSMAX,YSMAX,TF,XMAX,XMAXV,TO,TO)
       ENDIF
*
*  TEST SUR XMAX          MILL  8/3/91
*
       IF (XMAX.EQ.0.D0) THEN
         IF(INPLAS.EQ.29) THEN
             CALL DERTRA(NYOG,YOG,TF,XMAX,XMAXV,TO,TO)
             XMAX=XMAX*1.D-3
           ELSE
             XMAX=XMAT(1)*1.D-3
          ENDIF
       ENDIF
*
30     CONTINUE
C
C-----------------------------
       IF (KERRE.NE.0) THEN
         GOTO 999
       ENDIF
 
C
C===========================================================
C  A PARTIR DE MAINTENANT, LES DEFORMATIONS
C  DE CISAILLEMENT NE SONT PLUS
C  DEFINIES PAR DES GAMA.
C  ON DIVISE DONC LES TERMES DE CISAILLEMENT PAR 2.
C  CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
C  DE LEMAITRE (INPLAS=29).
C
C  SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
C      MFR=1  (MASSIF)
C      MFR=5  (COQUES EPAISSES)
C      MFR=3  (COQUES MINCES)
C      MFR=17 (TUYAUX FISSURES)
C      MFR = 31 (BBAR)
C      MFR=33 (POREUX)
C
       IF (INPLAS.NE.29) THEN
C
C  Cas de la formulation massive
C  Les termes de cisaillement apparaissent
C  au delà de la troisieme composante
C
         IF (MFR.EQ.1.OR.MFR.EQ.33.OR.MFR.EQ.31) THEN
           DO 11 I=4,NSTRS
             EPIN0(I)=EPIN0(I)/2d0
 11        CONTINUE
C
C  Cas des coques épaisses
C  Les termes de cisaillement apparaissent
C  au delà de la deuxieme composante
C
         ELSE IF (MFR.EQ.5) THEN
           DO 12 I=3,NSTRS
             EPIN0(I)=EPIN0(I)/2d0
 12        CONTINUE
C
C  Cas des coques minces
C  Les termes de cisaillement apparaissent
C  pour la troisieme et la sixieme composante
C  uniquement dans les cas de calculs
C  tridimensionnels ou d'analyse de Fourier
C
         ELSE IF (MFR.EQ.3) THEN
           IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
               EPIN0(3)=EPIN0(3)/2d0
               EPIN0(6)=EPIN0(6)/2d0
           ENDIF
C
C  Reste le cas des tuyaux fissurés (MFR=17)
C
         ENDIF
       ENDIF
C
C===========================================================
C
C ----------------
C  INITIALISATION
C ----------------
       ITERO = 0
 6543  CONTINUE
 
       itero = 1 + itero
       if( itero.ne.1) THEN
c             write(6,*) 'itero ib igau', itero,ib,igau
          dtlibr = .true.
          precis = precis * 7.
*          write(6,*)  ' precision modifiée ', precis
          if( itero. gt . 3) then
****          kerre = 460
              kerre = 268
              return
          endif
       endif
       DTLEFT = DT
       TAU    = DTLEFT
       TI0=T0
       TI1=TF
       TPOINT=(TF-T0)/DT
       ASIG = SQRT(PROCON(SIG0,SIG0,NSTRS))
       ERRABS = PRECIS*ASIG
       IF (XMAX.GT.ASIG) ERRABS = PRECIS*XMAX
       DO 40 I=1,NSTRS
         SIG(I) = SIG0(I)
         EPSV(I) = EPIN0(I)
         IF (INPLAS.NE.29) DSPT(I) = DSIGT(I)/DT
40     CONTINUE
*
*          iter=0
*       if( .NOT.DTLIBR) THEN
*           dtminl = ( dt * 1.001 ) / msopua
*           r = dtseco / dtprem
* 1245      continue
*          iter=iter+1
**          if ( abs ( 1.- R) . gt. 0.001 ) then
*           bb = ( 1 - r**(msoupa-10)) / ( 1 - r) * dtprem
*          else
*           r = 1.d0
*           bb = dtprem * ( msoupa - 10)
*          endif
*          tau = dtprem * dt / bb * 1.0001
*          write (6,1234)iter,dtprem,dtseco,dtdeux,r,bb,dt,tau
*          if(bb . lt . dt/1.2) THEN
*              if( iter.lt.15) then
*                r = r + abs ( 1. - r ) / 10.
*              else
*               kerre = 460
*               return
*             endif
*             go to 1245
*         endif
* 1234 format ('it pr se de r b t ta',i2, 7e9.3)
*
*           dtx = dt * 1.00001;
*           write(6,*) 'avpremdeux r', dtprem,dtdeux,r
*          call decoup(-msoupa+10,dtprem/dtx,dtdeux/dtx,r,nn,xde
*     $          ,xdf,dtx)
*           write(6,*) 'xde xdf de r',xde,xdf,r
*          tau = xde / r
*
*       endif
C
       IF (INPLAS.EQ.29) THEN
C
C================================================
C Calcul de l increment de deformation totale reel.
C On enleve donc tous les termes qui correspondent
C a l influence de la temperature et de
C l endommagement (travail inverse de ce qui est
C fait dans le procedure increme).
C================================================
C
********* materiau dependant de la temperature ***********************
           CALL DERTRA(NYOG,YOG,T0,YUNG0,YUNGV0,TO,TO)
           CALL DERTRA(NYNU,YNU,T0,ENU0,ENUV0,TO,TO)
           XMAT(1)=YUNG0
           XMAT(2)=ENU0
C------------------------------------------------
C Calcul de la matrice de Hooke inverse DD a t=t0
C------------------------------------------------
           CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,
     &     ENUV0,XCAR,ICARA,MFR,NSTRS,DD,DDV,KERRE,2,ITHHER)
C
********* materiau dependant de la temperature ***********************
           CALL DERTRA(NYOG,YOG,TF,YUNG1,YUNGV1,TO,TO)
           CALL DERTRA(NYNU,YNU,TF,ENU1,ENUV1,TO,TO)
           XMAT(1)=YUNG1
           XMAT(2)=ENU1
C---------------------------------------------------
C Calcul de la matrice de Hooke inverse DDINV a T=TF
C---------------------------------------------------
          CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,
     &    ENUV1,XCAR,ICARA,MFR,NSTRS,DDINV,DDV,KERRE,2,ITHHER)
***********************************************************************
C
           CALL DERTRA(NYALFA,YALFA,T0,ALFA0,ALFAV0,TO,TO)
           CALL DERTRA(NYALFA,YALFA,TF,ALFAF,ALFAVF,TO,TO)
           CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
C
C
           CALL ZDANUL(DSPT,NSTRS)
           AA=1.D0
           DO 45 I=1,NSTRS
             DSPT(I)=DEPST(I)
             IF (I.GT.3) AA=0.D0
             DO 46 J=1,NSTRS
               DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
               DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
46           CONTINUE
             DSPT(I)=DSPT(I)-(AA*CTEPS)
             DSPT(I)=DSPT(I)/DT
45         CONTINUE
       ENDIF
       DO 48 I=1,NVARI
48       VAR(I)=VAR0(I)
C
C ---------------------------------------------------------------------
       INV = 0
       NSSINC = 0
       nitera=0
C ---------------------------------------------------------------------
C       DEBUT DES ITERATIONS EN SSINCREMENTS  /FIN SI DTLEFT = 0
C ---------------------------------------------------------------------
  70   NSSINC = NSSINC + 1
       IF (NSSINC.GT.msoupa) THEN
       DTLIBR=.FALSE.
       GO TO 6543
*       GOTO 999
       ENDIF
C
C---------------------------------------------------------------------
C      START OF CALCULATIONS
C_____________________________________________________________________
       IF (MFR.EQ.17.AND.INPLAS.NE.19) GO TO 999
       IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.17) THEN
         CALL  XXPT1(SIG,EPSV,VAR,EVP1,VARP1,XPM1,XMAT,NSTRS,NVARI,
     &                                                NCOMAT,MFR)
       ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.((INPLAS.GE.19.AND.
     &         INPLAS.LE.24).OR.INPLAS.EQ.61)) THEN
         CALL  INCRE1(TAU,SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
     &                INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
       ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.25) THEN
         CALL  INCRE2(SIG,VAR,EVP1,VARP1,XMAT,XMAT0,NSTRS,MFR,
     &                NVARI,NCOMAT,VALMAT,VALMA0,DT)
       ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.76) THEN
         CALL  INCRA2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
     &                NVARI,NCOMAT)
       ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.77) THEN
         CALL  INCRB2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
     &                NVARI,NCOMAT)
       ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.53) THEN
         CALL  INCRE5(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
     &                NVARI,NCOMAT)
       ELSE IF(MFR.NE.3.AND.INPLAS.EQ.63) THEN
         CALL  INCRE7(SIG,VAR,DSPT,EVP1,VARP1,XMAT,NSTRS,MFR,
     &                NVARI,NCOMAT,IFOURB)
       ELSE IF(MFR.EQ.3.AND.((INPLAS.GE.19.AND.INPLAS.LE.24)
     &   .OR.INPLAS.EQ.61)) THEN
         CALL  INCRE3(TAU,SIG,EPSV,VAR,XMAT,EVP1,VARP1,ALFA,NSTRS,
     &                                        NVARI,INPLAS,NCOMAT)
       ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.25) THEN
         CALL  INCRE4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
     &                                             ,NVARI,NCOMAT)
       ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.76) THEN
         CALL  INCRA4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
     &                                             ,NVARI,NCOMAT)
       ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.77) THEN
         CALL  INCRB4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
     &                                             ,NVARI,NCOMAT)
       ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.53) THEN
         CALL  INCRE6(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS,
     &                                              NVARI,NCOMAT)
       ELSE IF (MFR.NE.3.AND.(INPLAS.EQ.85.OR.INPLAS.EQ.86.
     &          OR.INPLAS.EQ.84.OR.INPLAS.EQ.102)) THEN
         CALL DEVFLO(INPLAS,SIG,EPSV,VAR,XMAT,NCOMAT,NSTRS,NVARI,
     &                EVP1,VARP1,TAU)
       ELSE IF(MFR.NE.3.AND.INPLAS.EQ.70) THEN
         CALL  INCRE8(SIG,VAR,T0,TF,EVP1,VARP1,XMAT,NSTRS,
     &                                          MFR,NVARI,NCOMAT)
C
       ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.29) THEN
       if (nssinc.eq.1) then
C
C-----------------------------------------------------------
C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
C-----------------------------------------------------------
          CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &    YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI0,
     &    TINF,TSUP,ITEST,TRUC,NCOURB)
C
           IF (ITHHER.EQ.2) THEN
C********** materiau dependant de la temperature **********************
C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
           CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
     &     TO,TO,ITEST,TRUC,NCOURB)
C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
           CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
     &     TO,TO,ITEST,TRUC,NCOURB)
C**********************************************************************
           ENDIF
C--------------------------------------------------------------
C Calcul de la derivee de la dilatation thermique /temps a t=t0
C--------------------------------------------------------------
         CALL DERTRA(NYALFA,YALFA,TI0,ALFA0,ALFAV0,TO,TO)
         CALL ZDANUL(EPSTHD,NSTRS)
         CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
         DO 47 I=1,3
47         EPSTHD(I)=CTH
C
           CALL XXCREE(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,
     &     DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
     &     NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
     &     2,TI0,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
           CALL ESTITO(SIG,NSTRS,VAR,NVARI,YKX,NYKX,NKX,NNKX,
     &      XMAT,NCOMAT,TI0,TAUX,TRUC,NCOURB)
               else
           do i=1,nstrs
              sigp1(i)=sigp4(i)
              evp1(i)=evp4(i)
           enddo
           do i=1,nvari
              varp1(i)=varp4(i)
           enddo
        endif
       ELSE IF(MFR.EQ.17.AND.INPLAS.EQ.19) THEN
         CALL  TUFINC(TAU,SIG,EPSV,VAR,XMAT,XCAR,EVP1,VARP1,NSTRS,
     &                                NVARI,INPLAS,NCOMAT,KERREU1)
       ELSE IF(MFR.EQ.1.OR.MFR.EQ.31.AND.INPLAS.EQ.44) THEN
         CALL  POUDRA(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
     &                              NCOMAT,KERRE)
       ELSE IF(MFR.EQ.1.OR.MFR.EQ.31.AND.INPLAS.EQ.45) THEN
         CALL  POUDRB(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
     &                              NCOMAT,KERRE)
       ENDIF
C
       NITERA  = 0
C --------------------------------------------------------------------
C      DEBUT DES ITERATIONS SUR TAU OPTIMAL /FIN SI RA PETIT
C --------------------------------------------------------------------
  80   NITERA  = NITERA + 1
       IF(MFR.EQ.3) GO TO 150
       IF(MFR.EQ.17) GO TO 210
       IF(INPLAS.EQ.17) THEN
          tau2=tau*0.5d0
           CALL  AVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,EVP1,VARP1,
     &             XPM1,DSPT,XMAT,NSTRS,NVARI,NCOMAT,IFOURB,IVTEST,
     &             MFR)
           CALL  XXPT1(SIG1,EPSV1,VAR1,EVP2,VARP2,XPM2,XMAT,NSTRS,
     &                                         NVARI,NCOMAT,MFR)
           DO 90 I=1,NSTRS
             EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
             XPM2(I) = 0.5*(XPM1(I)+XPM2(I))
90         CONTINUE
           DO 100 I=1,4+NSTRS
100          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,EVP2,VARP2,
     &            XPM2,DSPT,XMAT,NSTRS,NVARI,NCOMAT,IFOURB,IVTEST,
     &            MFR)
           CALL  XXPT1(SIG12,EPSV12,VAR12,EVP3,VARP3,XPM3,XMAT,NSTRS,
     &                                         NVARI,NCOMAT,MFR)
           CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,EVP3,VARP3,XPM3,DSPT,XMAT,NSTRS,NVARI,NCOMAT
     &            ,IFOURB,IVTEST,MFR)
           CALL  XXPT1(SIG13,EPSV13,VAR13,EVP4,VARP4,XPM4,XMAT,NSTRS,
     &                                         NVARI,NCOMAT,MFR)
           DO  I=1,NSTRS
             EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
             XPM4(I) = 0.5*(XPM3(I)+XPM4(I))
          enddo
           DO I=1,4+NSTRS
              VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
           enddo
           CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $          ,EVP4,VARP4,XPM4,DSPT,XMAT,NSTRS,NVARI,NCOMAT
     &            ,IFOURB,IVTEST,MFR)
           CALL  XXPT1(SIGf,EPinf,VARf,EVP4,VARP4,XPM4,XMAT,NSTRS,
     &                                         NVARI,NCOMAT,MFR)
           DO  I=1,NSTRS
             EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
             XPM2(I) = (XPM1(I)+XPM4(I))/6d0+XPM3(I)*2d0/3d0
          enddo
           DO I=1,4+NSTRS
              VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL AVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $          ,EVP2,VARP2,XPM2,DSPT,XMAT,NSTRS,NVARI,NCOMAT
     &            ,IFOURB,IVTEST,MFR)
C---------
        ELSE IF(INPLAS.EQ.44) THEN
           tau2=tau*0.5d0
       CALL  AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &             VARP1,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRA(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       DO 105 I=1,NSTRS
       EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
 105   CONTINUE
       VARP2(1) = 0.5*(VARP1(1)+VARP2(1))
       CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &            VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRA(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $      ,DSPT,EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRA(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       DO I=1,NSTRS
          EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
       enddo
          VARP4(1) = 0.5d0*(VARP3(1)+VARP4(1))
       CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $      ,DSPT,EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRA(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       DO I=1,NSTRS
          EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
       enddo
          VARP2(1) = (VARP1(1)+VARP4(1))/6d0+VARP3(1)*2d0/3d0
       CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $      ,DSPT,EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
C---------
      ELSE IF(INPLAS.EQ.45) THEN
         tau2=tau*0.5d0
       CALL  AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &             VARP1,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRB(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       DO 106 I=1,NSTRS
       EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
 106   CONTINUE
       VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
       CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &            VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
C---------
C    CALCUL DE LA TAILLE DE GRAIN
C---------
       CALL  GRAIN(TAU2,EVP1,EVP2,SIG,SIG12,VAR,VAR12,XMAT,NSTRS,
     &             NVARI,KERRE)
c
       CALL  POUDRB(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       CALL  AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13
     &  ,DSPT,EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRB(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       DO I=1,NSTRS
          EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
       enddo
          VARP4(1) = 0.5d0*(VARP1(1)+VARP2(1))
       CALL  AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     &        ,DSPT,EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
       CALL  POUDRB(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,NVARI,
     &                               NCOMAT,KERRE)
       DO I=1,NSTRS
          EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
       enddo
          VARP2(1) =(VARP1(1)+VARP2(1))/6d0+VARP3(1)*2d0/3d0
       CALL  AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     &        ,DSPT,EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
C---------
C    CALCUL DE LA TAILLE DE GRAIN
C---------
       CALL  GRAIN(TAU2,EVP3,EVP4,SIG12,SIGf,VAR12,VARf,XMAT,NSTRS,
     &             NVARI,KERRE)
C---------
         ELSE IF((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61
     &       )THEN
            tau2=tau*0.5d0
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                 VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL INCRE1(TAU,SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
     &                 INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
           DO 110 I=1,NSTRS
110          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           IF(INPLAS.EQ.24) THEN
               DO 115 I=1,NVARI
115              VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
             ELSE
               DO 120 I=1,2*NSTRS+2
120              VARP2(I)= 0.5*(VARP1(I) + VARP2(I))
               DO 130 I=2*NSTRS+4,NVARI
130              VARP2(I)= 0.5*(VARP1(I) + VARP2(I))
           ENDIF
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL INCRE1(TAU2,SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,
     &                 NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
     &                 EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL INCRE1(TAU2,SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,
     &                 NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
           DO I=1,NSTRS
              EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
           enddo
           IF(INPLAS.EQ.24) THEN
             DO I=1,NVARI
              VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
             enddo
             ELSE
               DO I=1,2*NSTRS+2
                  VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
               enddo
               DO  I=2*NSTRS+4,NVARI
                  VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
               enddo
           ENDIF
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
     &                 EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL INCRE1(TAU2,SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,
     &                 NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
           DO I=1,NSTRS
              EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           IF(INPLAS.EQ.24) THEN
             DO I=1,NVARI
              VARP2(I)=(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
             enddo
             ELSE
               DO I=1,2*NSTRS+2
                  VARP2(I)=(VARP1(I) + VARP4(I))/6d0+VARP3(I)*2d0/3d0
               enddo
               DO  I=2*NSTRS+4,NVARI
                  VARP2(I)= (VARP1(I) + VARP4(I))/6d0+VARP3(I)*2d0/3d0
               enddo
           ENDIF
           CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
C---------
        ELSE IF(INPLAS.EQ.25) THEN
           tau2=tau*0.5d0
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                 VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE2(SIG1,VAR1,EVP2,VARP2,XMAT,XMAT0,NSTRS,MFR,
     &                 NVARI,NCOMAT,VALMAT,VALMA0,DT)
           DO 135 I=1,NSTRS
135          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           DO 140 I=1,NVARI
140          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE2(SIG12,VAR12,EVP3,VARP3,XMAT,XMAT0,NSTRS,MFR,
     &                  NVARI,NCOMAT,VALMAT,VALMA0,DT)
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
     &                 EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE2(SIG13,VAR13,EVP4,VARP4,XMAT,XMAT0,NSTRS,MFR,
     &                  NVARI,NCOMAT,VALMAT,VALMA0,DT)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
     &                 EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE2(SIGf,VARf,EVP4,VARP4,XMAT,XMAT0,NSTRS,MFR,
     &                 NVARI,NCOMAT,VALMAT,VALMA0,DT)
           DO I=1,NSTRS
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
C---------
        ELSE IF(INPLAS.EQ.76) THEN
           tau2=tau*0.5d0
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                 VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRA2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           DO 1135 I=1,NSTRS
1135          EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
           DO 1140 I=1,NVARI
1140          VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRA2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
     &                 EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRA2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
     &                 EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRA2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           DO I=1,NSTRS
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) = (VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
C---------
        ELSE IF(INPLAS.EQ.77) THEN
           tau2=tau*0.5d0
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                 VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRB2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           DO I=1,NSTRS
              EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
           enddo
           DO I=1,NVARI
              VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
           enddo
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRB2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
     &                 EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRB2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
     &                 EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRB2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
     &                                                    NCOMAT)
           DO I=1,NSTRS
              EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
C---------
        ELSE IF(INPLAS.EQ.53) THEN
           tau2=tau*0.5d0
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                 VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
 
           CALL  INCRE5(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
           DO 137 I=1,NSTRS
137          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           DO 141 I=1,NVARI
141          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE5(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
     &                 EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE5(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
     &                 EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE5(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
     &                 VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
C---------
        ELSE IF(INPLAS.EQ.85.OR.INPLAS.EQ.86.OR.INPLAS.EQ.84
     &         .OR.INPLAS.EQ.102) THEN
           tau2=tau*0.5d0
           CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &               VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,
     &               MFR)
           CALL DEVFLO(INPLAS,SIG1,EPSV1,VAR1,XMAT,NCOMAT,NSTRS,NVARI
     &                ,EVP2,VARP2,TAU2)
 
           DO 739 I=1,NSTRS
739          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           DO 741 I=1,NVARI
741          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
C       >>>>  SI JE SUIS SUR LE PREMIER PAS &lt;&lt;&lt;&lt;
C       et que j'ai calcule le resultat a la main
C       _________________________________________
           IF (VAR(12).GT.1.) THEN
 
             DO 788 I=1,NVARI
788             VARP2(I) = VARP1(I)
             DO 737 I=1,NSTRS
                EVP2(I) = EVP1(I)
737          CONTINUE
           ENDIF
 
           CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &            VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
           CALL DEVFLO(INPLAS,SIG12,EPSV12,VAR12,XMAT,NCOMAT,
     $          NSTRS,NVARI,EVP3,VARP3,TAU2)
           CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,
     $          DSPT,EVP3,
     &            VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
           CALL DEVFLO(INPLAS,SIG13,EPSV13,VAR13,XMAT,NCOMAT,
     $          NSTRS,NVARI,EVP4,VARP4,TAU2)
C           print*,'==>4',VARP4(2),VARP4(3)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
c
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,
     $          DSPT,EVP4,
     &            VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
           CALL DEVFLO(INPLAS,SIGf,EPinf,VARf,XMAT,NCOMAT,
     $          NSTRS,NVARI,EVP4,VARP4,TAU2)
           DO I=1,NSTRS
              EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
c
           DO I=1,NVARI
              VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
C            print*,'==>5',VARP2(2),VARP2(3)
           CALL ADVFLO(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,
     $          DSPT,EVP2,
     &            VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
C---------
         ELSE IF(INPLAS.EQ.63) THEN
            tau2=tau*0.5d0
           CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &               VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,
     &               MFR)
           CALL  INCRE7(SIG1,VAR1,DSPT,EVP2,VARP2,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT,IFOURB)
           DO 138 I=1,NSTRS
138          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           DO 142 I=1,NVARI
142          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &             VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
           CALL  INCRE7(SIG12,VAR12,DSPT,EVP3,VARP3,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT,IFOURB)
           CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,DSPT,EVP3,
     &             VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
           CALL  INCRE7(SIG13,VAR13,DSPT,EVP4,VARP4,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT,IFOURB)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $          ,DSPT,EVP4,
     &             VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
           CALL  INCRE7(SIGf,VARf,DSPT,EVP4,VARP4,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT,IFOURB)
           DO I=1,NSTRS
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVDDI(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $          ,DSPT,EVP2,
     &             VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
C--------
        ELSE IF(INPLAS.EQ.70) THEN
           tau2=tau*0.5d0
           CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                 VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           t12=(t0+tf)*0.5d0
           CALL  INCRE8(SIG1,VAR1,T0,T12,EVP2,VARP2,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
C
        DO 177 I=1,NSTRS
177     EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
        DO 178 I=1,NVARI
178     VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
        CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
     &              VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE8(SIG12,VAR12,T12,TF,EVP3,VARP3,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
        CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
     &              EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
           CALL  INCRE8(SIG13,VAR13,T12,TF,EVP4,VARP4,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
        DO I=1,NSTRS
           EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
        enddo
        DO I=1,NVARI
           VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
        enddo
        CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
     &              EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
        CALL  INCRE8(SIGf,VARf,T12,TF,EVP4,VARP4,XMAT,NSTRS,MFR,
     &                  NVARI,NCOMAT)
        DO I=1,NSTRS
           EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
        enddo
        DO I=1,NVARI
           VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
        enddo
        CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
     &              VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
C---------
      ELSE IF(INPLAS.EQ.29) THEN
 
 143   TAU2=TAU/2.D0
       CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
     &               VARP1,NSTRS,NVARI)
C
C-----------------------------------------------------------
C Mise a jour eventuelle de la nouvelle temperature TI1
C-----------------------------------------------------------
C
          DELTAT=TPOINT*TAU2
          TI12=TI0+DELTAT
C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
C-----------------------------------------------------------
          CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI12,
     &     TINF,TSUP,ITEST,TRUC,NCOURB)
C
           IF (ITHHER.EQ.2) THEN
C********** materiau dependant de la temperature **********************
C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
           CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
     &     TO,TO,ITEST,TRUC,NCOURB)
C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
           CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
     &     TO,TO,ITEST,TRUC,NCOURB)
C**********************************************************************
           ENDIF
C------------------------------------------------------------------
C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
C------------------------------------------------------------------
         CALL DERTRA(NYALFA,YALFA,TI12,ALFA1,ALFAV1,TO,TO)
         CALL ZDANUL(EPSTHD,NSTRS)
         CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
         DO 136 I=1,3
136         EPSTHD(I)=CTH
C
           CALL XXCREE(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
     &     DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
     &     NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
     &     2,TI12,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
C
        do 1360 i=1,nstrs
         sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
         evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
 1360   continue
        do 1361 i=1,nvari
         varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
 1361 continue
          t=tau2
       CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,
     &    EVP2,  VARP2,NSTRS,NVARI)
       if (tau2.ne.t)then
          tau=2d0*tau2
          goto 143
       endif
 
C
           CALL XXCREE(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
     &     DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
     &     NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
     &     2,TI12,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
 
       CALL AVANXX(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,SIGP3,
     &    EVP3,  VARP3,NSTRS,NVARI)
          DELTAT=TPOINT*TAU
          TI1=TI0+DELTAT
C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
C-----------------------------------------------------------
          CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI1,
     &     TINF,TSUP,ITEST,TRUC,NCOURB)
           IF (ITHHER.EQ.2) THEN
C********** materiau dependant de la temperature **********************
C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
           CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
     &     TO,TO,ITEST,TRUC,NCOURB)
C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
           CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
     &     YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
     &     YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
     &     TO,TO,ITEST,TRUC,NCOURB)
C**********************************************************************
           ENDIF
C------------------------------------------------------------------
C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
C------------------------------------------------------------------
         CALL DERTRA(NYALFA,YALFA,TI1,ALFA1,ALFAV1,TO,TO)
         CALL ZDANUL(EPSTHD,NSTRS)
         CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
         DO 1362 I=1,3
1362         EPSTHD(I)=CTH
C
           CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
     &     DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
     &     NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
     &     2,TI1,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
 
        do 1363 i=1,nstrs
          sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
          evp4(i)  =0.5D0*(  evp4(i)+ evp3(i))
 1363 continue
       do 1364 i=1,nvari
         varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
 1364 continue
       call avanxx(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
     &    EVP4,  VARP4,NSTRS,NVARI)
 
           CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
     &     DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
     &     NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
     &     2,TI1,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
           DO 145 I=1,NSTRS
          EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
          SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
145        CONTINUE
           DO 148 I=1,NVARI
148      VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
           T=TAU
           CALL AVANXX(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,SIGP2,EVP2,
     &       VARP2,NSTRS,NVARI)
c       IF (TAU.NE.T) GOTO 143
       ENDIF
       GO TO 250
C _____________________________________________________________________
150    CONTINUE
C----------------------------------------------------------------------
C  CALCULATIONS FOR GENERALISED STRESS/STRAIN FORMULATIONS
C----------------------------------------------------------------------
       IF((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61
     &      ) THEN
          tau2=tau*0.5d0
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
     &                VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE3(TAU2,SIG1,EPSV1,VAR1,XMAT,EVP2,VARP2,ALFA,
     &                                  NSTRS,NVARI,INPLAS,NCOMAT)
           DO 160 I=1,NSTRS,1
160          EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
           IF(INPLAS.EQ.24) THEN
               DO 165 I=1,NVARI
165              VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
             ELSE
              DO 170 I=1,2*NSTRS+2
170             VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
              DO 180 I=2*NSTRS+4,NVARI
180             VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
           ENDIF
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
     &        EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE3(TAU2,SIG12,EPSV12,VAR12,XMAT,EVP3,VARP3,ALFA,
     &                                  NSTRS,NVARI,INPLAS,NCOMAT)
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,DSPT,
     &        EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE3(TAU2,SIG13,EPSV13,VAR13,XMAT,EVP4,VARP4,ALFA,
     &                                  NSTRS,NVARI,INPLAS,NCOMAT)
           DO I=1,NSTRS,1
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
              enddo
           IF(INPLAS.EQ.24) THEN
               DO I=1,NVARI
                  VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
               enddo
           ELSE
              DO I=1,2*NSTRS+2
                 VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
              enddo
              DO I=2*NSTRS+4,NVARI
                 VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
              enddo
           ENDIF
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
     &        EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE3(TAU2,SIGf,EPinf,VARf,XMAT,EVP4,VARP4,ALFA,
     &                                  NSTRS,NVARI,INPLAS,NCOMAT)
           DO I=1,NSTRS,1
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           IF(INPLAS.EQ.24) THEN
               DO I=1,NVARI
                  VARP2(I)=(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
               enddo
           ELSE
              DO I=1,2*NSTRS+2
                 VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
              enddo
              DO I=2*NSTRS+4,NVARI
                 VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
              enddo
           endif
           CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,
     &        EVP2,VARp2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
C---------
        ELSE IF(INPLAS.EQ.25) THEN
           tau2=tau*0.5d0
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
     &         EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO 190 I=1,NSTRS
190          EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
           DO 195 I=1,NVARI
195          VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,DSPT,
     &       EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $          ,DSPT,
     &       EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $          ,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
C---------
        ELSE IF(INPLAS.EQ.76) THEN
           tua2=tau*0.5d0
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
     &         EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRA4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO 1190 I=1,NSTRS
1190          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           DO 1195 I=1,NVARI
1195          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRA4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,DSPT,
     &       EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRA4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $          ,DSPT,
     &       EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           DO I=1,NSTRS
              EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
C---------
        ELSE IF(INPLAS.EQ.77) THEN
           tau2=tau*0.5d0
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
     &         EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRB4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO 2190 I=1,NSTRS
2190          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
           DO 2195 I=1,NVARI
2195          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRB4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,DSPT,
     &       EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRB4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $          ,DSPT,
     &       EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRB4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $          ,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
C---------
        ELSE IF(INPLAS.EQ.53) THEN
           tau2=tau*0.5d0
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
     &         EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE6(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO 191 I=1,NSTRS
191          EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
 
           DO 196 I=1,NVARI
196          VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
           CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE6(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $          ,DSPT,
     &       EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE6(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
           enddo
           DO I=1,NVARI
              VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
           enddo
           CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $          ,DSPT,
     &       EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
           CALL INCRE6(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
     &                                          NVARI,NCOMAT)
           DO I=1,NSTRS
              EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
           enddo
           DO I=1,NVARI
              VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
           enddo
           CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $          ,DSPT,
     &       EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
C---------
       ENDIF
       GO TO 250
C
C CAS D'UN TUYAU FISSURE EN FLUAGE SUIVANT LA LOI "NORTON"
C
 210   CONTINUE
       IF(INPLAS.NE.19) GO TO 999
       tau2=tau*0.5d0
       CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,VARP1,
     &                   XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
       CALL TUFINC(TAU2,SIG1,EPSV1,VAR1,XMAT,XCAR,EVP2,VARP2,NSTRS,
     &                                  NVARI,INPLAS,NCOMAT,KERREU1)
       DO 220 I=1,6
       EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
 220   CONTINUE
       DO 230 I=1,4
       VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
 230   CONTINUE
       DO 240 I=6,NVARI
       VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
 240   CONTINUE
       CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12
     $      ,DSPT,EVP2,VARP2,
     &                   XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
       CALL TUFINC(TAU2,SIG12,EPSV12,VAR12,XMAT,XCAR,EVP3,VARP3,NSTRS,
     &                                  NVARI,INPLAS,NCOMAT,KERREU1)
       CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
     $      ,DSPT,EVP3,VARP3,
     &                   XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
       CALL TUFINC(TAU2,SIG13,EPSV13,VAR13,XMAT,XCAR,EVP4,VARP4,NSTRS,
     &                                  NVARI,INPLAS,NCOMAT,KERREU1)
       DO I=1,6
          EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
       enddo
       DO I=1,4
          VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
       enddo
       DO I=6,NVARI
          VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
       enddo
       CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
     $      ,DSPT,EVP4,VARP4,
     &                   XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
       CALL TUFINC(TAU2,SIGf,EPinf,VARf,XMAT,XCAR,EVP4,VARP4,NSTRS,
     &                                  NVARI,INPLAS,NCOMAT,KERREU1)
       DO I=1,6
          EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
       enddo
       DO I=1,4
          VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
       enddo
       DO I=6,NVARI
          VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
       enddo
       CALL TUFADV(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
     $      ,DSPT,EVP2,VARP2,
     &                   XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
C
C----------------------------------------------------------------------
 250   CONTINUE
C ---------------------------------------------------------------------
C   CALCUL DU RAPPORT : ERREUR CALCULEE / ERREUR ADMISE
C ---------------------------------------------------------------------
       DO 260 I=1,NSTRS
260      XX(I) = SIGF(I)-SIG1(I)
       RA = SQRT(PROCON(XX,XX,NSTRS))/(ERRABS)
c
       IF (MFR.EQ.17.AND.INPLAS.EQ.19) THEN
       RA=SQRT(XX(1)**2 + XX(6)**2)/ERRABS
       ENDIF
       SQRA = SQRT(RA)
       IF (INPLAS.EQ.29) THEN
           RD = 0.D0
           IF (VARF(3).NE.0.D0.AND.VAR1(3).GT.1.0D-5) THEN
              RD = (VARF(3)-VAR1(3))/VARF(3)
              RD = ABS(RD)/1.D-4
           ENDIF
           RA =  MAX(RA,RD)
           SQRA = SQRT(RA)
       ENDIF
C ---------------------------------------------------------------------
C  TEST DE FIN D'ITERATIONS /  MISE A JOUR DE TAU  /OPTION JECHER
C  DIV =7   BORNE = 2
C  SI   SQRA>7   TAU = TAU/7    ET NOUVEL ESSAI
C  SI 2&lt;RA&lt;7*7   ON VISE RA = 1  ET NOUVEL ESSAI
C ------------------------------------------------------------------
       IF(dtlibr) Then
c petite ruse pour dejouer l'optimisation
                 ra1=ra*1d0
         IF ((RA.GT.DIV*DIV).OR.(RA.NE.RA1)) THEN
           TAU = TAU/div
           IF (INPLAS.EQ.29) TAU =MIN(TAU,TAUX)
           DELTAT=TPOINT*TAU
           TI1=TI0+DELTAT
           GOTO 80
         ELSEIF ( RA.GT.(BORNE)) THEN
           TAU = TAU/SQRA
           IF (INPLAS.EQ.29) TAU =MIN(TAU,TAUX)
           DELTAT=TPOINT*TAU
           TI1=TI0+DELTAT
           GOTO 80
        ENDIF
      endif
C ---------------------------------------------------------------------
C       ici  ra &lt; borne      cas JECHER  :
C ---------------------------------------------------------------------
C je n'ai pas trouvé comment jecher = 1 pour moi jamais. TC
       IF (JECHER.EQ.1) THEN
*       write(6,*) ' on passe dans jecher = 1'
           DTT = TAU
           NSSINC = NITERA
           IF ((NSSINC.EQ.1).AND.(RA.EQ.0.0)) GOTO 999
           IF (NITERA.GE.8) GOTO 999
           IF (FAC*SQRA.LT.1.0) THEN
               TAU = TAU*FAC
               DELTAT=TPOINT*TAU
               TI1=TI0+DELTAT
               GOTO 80
             ELSEIF ((SQRA.LT.RMIN).OR.(SQRA.GT.RMAX)) THEN
               TAU = TAU/SQRA
               DELTAT=TPOINT*TAU
               TI1=TI0+DELTAT
               GOTO 80
           ENDIF
C ---------------------------------------------------------------------
C         ici  rmin &lt; sqra &lt; rmax    et  nitera &lt; 8
C         pas de mise @ jour des variables
C ---------------------------------------------------------------------
          GOTO 999
       ENDIF
C ----------------------------------------------------------------------
C  FIN D'ITERATIONS  / MISE A JOUR DES VARIABLES
C  ici RA &lt; BORNE
C  fin des boucles sur tau optimal
C  on avance en temps
C  mise @ jour de SIG etc...
C -------------------------------------------------------------------
       INV = INV + IVTEST
       DO 270 I=1,NSTRS,1
         SIG(I)  = SIGF(I)
         EPSV(I) = EPINF(I)
270    CONTINUE
       DO 280 I=1,NVARI,1
         VAR(I)  = VARF(I)
280    CONTINUE
*        IF( nssinc.eq. 1) dtprem = tau
*        IF( nssinc.eq. 2) dtseco = tau
C
       IF (INPLAS.EQ.29) THEN
C--------------------------------------------------------------
C Estimation du pas de temps apres la mise a jour des variables
C--------------------------------------------------------------
C
        CALL ESTITO(SIG,NSTRS,VAR,NVARI,YKX,NYKX,NKX,NNKX,
     &                            XMAT,NCOMAT,TI1,TD,TRUC,NCOURB)
 
         IF ((VARF(3).GE.0.96).OR.(TD.LT.1.D0)) THEN
           VARF(3)=1.D0
           TLIFE = DT - (DTLEFT - TAU)
           GOTO 999
         ENDIF
       ENDIF
C
C --------------------------------------------------------------------
C  TEST DE FIN SS INCREMENTS /  MISE A JOUR DE TAU
C  si   SQRA&lt;1/3        TAU = TAU*3
C  si   1/3&lt;SQRA&lt;RMIN   on vise RA = 1
C  si   RMIN&lt;SQRA&lt;RMAX  TAU inchang{
C  si   SQRA>RMAX       on vise RA = 1
C    fin des boucles en ss increments  si tau = dtleft
C --------------------------------------------------------------------
C
       IF ( TAU.LT.DTLEFT ) THEN
*           DTDEUX=TAU
           DTLEFT = DTLEFT - TAU
*           IF(dtlibr) then
             IF ( FAC*SQRA.LT.1.D0) THEN
               TAU=TAU*FAC
             ELSEIF ( (SQRA.LT.RMIN).OR.(SQRA.GT.RMAX) ) THEN
               TAU=TAU/SQRA
             ENDIF
*          else
*            TAU = TAU * R
*          endif
          IF (TAU.GT.DTLEFT) TAU = DTLEFT
          IF  (INPLAS.EQ.29) THEN
C----------------------------------------------------------------------------
C Mise a jour des temperatures
C TI0 temperature au dedut du pas de sous-incrementation avec TINF&lt;TI0&lt;TSUP
C      TI1 temperature a la fin du pas de sous-incrementation
C-----------------------------------------------------------------------------
              TI0=TI1
             DELTAT=TPOINT*TAU
             TI1=TI0+DELTAT
         ENDIF
 
         GOTO 70
      ENDIF
C
      IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN
         WRITE ( IOIMP,* ) ' PROBLEME   TAU > DTLEFT '
         KERRE = 223
      ENDIF
C-----------------------------------------------------------------------
999   CONTINUE
      IF(MFR.EQ.3) THEN
         DO 1000 I=1,NSTRS/2
           SIGF(        I) =SIGF(         I)*THICK
           SIGF(NSTRS/2+I) =SIGF(NSTRS/2+ I)*THICK*THICK/6.0
*           DSIGT(        I)=DSIGT(        I)*THICK
*           DSIGT(NSTRS/2+I)=DSIGT(NSTRS/2+I)*THICK*THICK/6.0
1000     CONTINUE
      ENDIF
 
C
C===========================================================
C  RETOUR A LA DEFINITION NORMALE DES DEFORMATIONS
C  A SAVOIR: LES DEFORMATIONS DE CISAILLEMENT SONT
C  DEFINIES PAR DES GAMA.
C  ON MULTIPLIE DONC LES TERMES DE CISAILLEMENT PAR 2.
C  CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
C  DE LEMAITRE (INPLAS=29).
C
C  SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
C      MFR=1  (MASSIF)
C      MFR=5  (COQUES EPAISSES)
C      MFR=3  (COQUES MINCES)
C      MFR=17 (TUYAUX FISSURES)
C      MFR = 31 (BBAR)
C      MFR=33 (POREUX)
C
       IF (INPLAS.NE.29) THEN
C
C  Cas de la formulation massive
C  Les termes de cisaillement apparaissent
C  au delà de la troisieme composante
C
         IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
           DO 14 I=1,NSTRS
             A=1.D0
             IF (I.GT.3) A=2.D0
             EPIN0(I)=EPIN0(I)*A
             EPINF(I)=EPINF(I)*A
 14        CONTINUE
C
C  Cas des coques épaisses
C  Les termes de cisaillement apparaissent
C  au delà de la deuxieme composante
C
         ELSE IF (MFR.EQ.5) THEN
           DO 15 I=1,NSTRS
             A=1.D0
             IF (I.GT.2) A=2.D0
             EPIN0(I)=EPIN0(I)*A
             EPINF(I)=EPINF(I)*A
 15        CONTINUE
C
C  Cas des coques minces
C  Les termes de cisaillement apparaissent
C  pour la troisieme et la sixieme composante
C  uniquement dans les cas de calculs
C  tridimensionnels ou d'analyse de Fourier
C
         ELSE IF (MFR.EQ.3) THEN
           IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
             DO 16 I=1,NSTRS
               A=1.D0
               IF (I.EQ.3) A=2.D0
               IF (I.EQ.6) A=2.D0
               EPIN0(I)=EPIN0(I)*A
               EPINF(I)=EPINF(I)*A
 16          CONTINUE
           ENDIF
C
C  Reste le cas des tuyaux fissurés (MFR=17)
C
         ENDIF
       ENDIF
C
C===========================================================
C
 998  RETURN
      END