Sources Esope | Cast3M

beton
C BETON     SOURCE    GF238795  18/02/05    21:15:01     9726           
      SUBROUTINE BETON(SIG0,DEPST,VAR0,XMAT,IVAL,NCOMAT,XCAR,
     1   DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,IB,IGAU,EPAIST,
     2   MELE,NPINT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
     3   ROTHOO,DDHOMU,CRIGI,DSIGT,SIGF,VARF,DEFP,NBPGAU,KERRE
     4, ecou,necou,iecou)
C
C----------------------------------------------------------------------
C             PLASTICITE MODELE BETON
C
C ENTREES
C     SIG0(NSTRS)   = CONTRAINTES INITIALES
C     NSTRS         = NOMBRE DE CONTRAINTES
C     DEPST(NSTRS)  = INCREMENT DE CONTRAINTES TOTALES
C     VAR0(NVARI)   =  VARIABLES INTERNES DEBUT
C     VAR0(   1 )   =  EPSE
C     VAR0(   2 )   =  DAM1
C     VAR0(   3 )   =  DAM2
C     VAR0(   4 )   =  DAM3
C     VAR0(   5 )   =  OUV1
C     VAR0(   6 )   =  OUV2
C     VAR0(   7 )   =  OUV3
C     VAR0(   8 )   =  LAMD
C     VAR0(   9 )   =  VF1(1)
C     VAR0(  10 )   =  VF1(2)
C     VAR0(  11 )   =  VF1(3)
C     VAR0(  12 )   =  VF2(1)
C     VAR0(  13 )   =  VF2(2)
C     VAR0(  14 )   =  VF2(3)
C     VAR0(  15 )   =  VF3(1)
C     VAR0(  16 )   =  VF3(2)
C     VAR0(  17 )   =  VF3(3)
C     XMAT(NCOMAT)  =  COMPOSANTES DE MATERIAU
C     IVAL(NCOMAT)  =  INDICE DES COMPOSANTES DE MATERIAU
C     NCOMAT        = NOMBRE DE COMPOSANTES DE MATERIAU
C     XCAR(ICARA)   =  CARACTERISTIQUES
C     MFR           =  NUMERO DE LA FORMULATION DE L'ELEMENT FINI
C                   = 1       MASSIF
C                   = 3       COQUE MINCE ( COQ2 , COQ3  ET DKT )
C                   = 5       COQUE EPAISSE ( COQ6 , COQ8 )
C                   = 7       POUTRE
C                   = 9       COQUE MINCE AVEC CISAILLEMENT TRANSVERSE
C                                    ( COQ4 ET DST )
C                   = 11      LIQUIDE
C                   = 13      TUYAU
C                   = 15      LINESPRING
C                   = 17      TUYAU FISSURE
C                   = 19      RACCORD MASSIF
C                   = 21      RACCORD COQUE
C                   = 23      SURFACE LIBRE
C                   = 25      MEMBRANE
C                   = 27      UNIAXIALE
C                   = 29      THERMIQUE
C                   = 31      INCOMPRESSIBLES
C                   = 33      POREUX
C                   = 35      JOINT
C                   = 37      HOMOGENEISE
C                   = 39      TUYO
C                   = 41      TUYAU ACOUSTIQUE PURE
C                   = 43      RACCORD TUYAU FLUIDE
*    DDAUX = MATRICE DE HOOKE ELASTIQUE
*    NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS
*    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
*    MFR   = NUMERO DE LA FORMULATION
*    IFOU  =
*    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
*    POUR LE CALCUL DE LA MATRICE DE HOOKE
C
C  SORTIES
C     SIGF(NSTRS)   = CONTRAINTES FINALES
C     VARF(NVARI)   = VARIABLES INTERNES FINALES
C     DEFP(NSTRS)   = DEFORMATIONS PLASTIQUES
C     KERRE         = 0    TOUT OK
C        1   SI DLAMBDA NEGATIF
C        2   NOMBRE MAX D ITERATIONS INTERNES DEPASSE
C       21   ON NE TROUVE PAS L INTERSECTION AVEC LA SURFACE DE CHARGE
C       22   SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
C
C-----------------------------------------------------------------------
C      VARIABLES PASSEES PAR LES COMMONS COPTIO , ECOU  ET NECOU
C
C  IFOUR    INDICE DU TYPE DE PROBLEME
C            -3  DEFORMATIONS PLANES GENERALISEES
C            -2  CONTRAINTES PLANES
C            -1  DEFORMATIONS PLANES
C             0  AXISYMETRIQUE
C             1  SERIE DE FOURIER
C             2  TRIDIMENSIONNEL
C  ITYP      TYPE DE FORMULATION MECANIQUE
C  --------------- ATTENTION ---------------
C     IL EST ACTIF APRES L APPEL DE VISAVI
C  -----------------------------------------
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
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
       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,NSTRS,MFR,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
 
        SEGMENT ECOU
***     COMMON/ECOU/TEST,ALFAH,
*       REAL*8 ecow00,ecow0,
      REAL*8 TEST, ALFAH,
     1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6),
C     1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
     2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
     2 ecow12(6),
C     2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
     1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
C     1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
     2 ecow17(6),ecow18(6),ecow19,ecow20
C     2 SIPLAD(6),DSIGP0(6),TET,TETI
      ENDSEGMENT
C      COMMON/ECOU/TEST,ALFAH,ZOZO(112)
       SEGMENT NECOU
*      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
C       INTEGER ncow1,  ncow2,ncow3,ncow4,  ncow5,
       INTEGER NCOURB,IPLAST,IT,   IMAPLA,ISOTRO,
     1  ITYP,IFOU, ncow8,
C    . ITYP, IFOURB,IFLUAG,
     2 ncow9,ncow10,ncow11,ncow12,ncow13,
C    . ICINE,ITHER, IFLUPL,ICYCL, IBI,
     3 ncow14,ncow15,ncow16,
C    . JFLUAG,KFLUAG,LFLUAG,
     4 ncow17,ncow18,ncow19,ncow20,ncow21
C    . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
      ENDSEGMENT
 
C     COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,ITYP,IZOZO(15)
C
 
      DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),IVAL(*)
      DIMENSION SIGF(*),VARF(*),DEFP(*)
      DIMENSION SIGMA(6),DSIGMA(6),STOT(6),SIGFIN(6),ORMAT(1)
      DIMENSION XLAMBD(6),DEFPLA(6),DEPS(6),DSIGT(*)
      DIMENSION SPHER(6),AUXIL(6),DSIGZE(6)
      DIMENSION VF1(3),VF2(3),VF3(3),XLTR(3),XLTT(3),EPTR(3),EPTT(3),
     .          EPRS(3),OUVER(3),RT(3)
      DIMENSION W1(3),W2(3),W3(3),YLTR(3),YLTT(3),DETR(3),DETT(3),
     .          DERS(3),FISSU(3),ST(3)
      DIMENSION VALMAT(*),VALCAR(*)
      DIMENSION TXR(IDIM,*),CRIGI(12)
      DIMENSION DDAUX(LHOOK,*),DDHOMU(LHOOK,*)
      DIMENSION XLOC(3,3),XGLOB(3,3)
      DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
      CHARACTER*8 CMATE
      INTEGER IFIS
      IFIS=0
C
C
C TEST DE CONSISTANCE DES DONNEES
C
      DO 100 I=1,NCOMAT
      IF(XMAT(I).LT.0.D0) KERRE=437
  100 CONTINUE
      IF(KERRE.EQ.437) RETURN
C
      YOUN= 0.D0
      XNU = 0.D0
      RHO = 0.D0
      ALPH= 0.D0
      CTR1= 0.D0
      ETR1= 0.D0
      CTT1= 0.D0
      ETT1= 0.D0
      ERS1= 0.D0
      CTR2= 0.D0
      ETR2= 0.D0
      CTT2= 0.D0
      ETT2= 0.D0
      ERS2= 0.D0
      CTR3= 0.D0
      ETR3= 0.D0
      CTT3= 0.D0
      ETT3= 0.D0
      ERS3= 0.D0
      BETR= 0.D0
      CLCS= 0.D0
      EPCS= 0.D0
      CLBI= 0.D0
      VF1(1)= 0.D0
      VF1(2)= 0.D0
      VF1(3)= 0.D0
      VF2(1)= 0.D0
      VF2(2)= 0.D0
      VF2(3)= 0.D0
      VF3(1)= 0.D0
      VF3(2)= 0.D0
      VF3(3)= 0.D0
*
*    VARIABLE IDECA POUR SE DECALER EN CAS D'EPAISSEUR EN CP
*
      IDECA=1
      IF(IFOUR.EQ.-2) IDECA=2
C
      YOUN= XMAT(1)
      XNU = XMAT(2)
      RHO = XMAT(3)
      ALPH= XMAT(4)
      CTR1= XMAT(5+IDECA)
      ETR1= XMAT(6+IDECA)
      CTT1= XMAT(7+IDECA)
      ETT1= XMAT(8+IDECA)
      ERS1= XMAT(9+IDECA)
      CTR2= XMAT(10+IDECA)
      ETR2= XMAT(11+IDECA)
      CTT2= XMAT(12+IDECA)
      ETT2= XMAT(13+IDECA)
      ERS2= XMAT(14+IDECA)
      CTR3= XMAT(15+IDECA)
      ETR3= XMAT(16+IDECA)
      CTT3= XMAT(17+IDECA)
      ETT3= XMAT(18+IDECA)
      ERS3= XMAT(19+IDECA)
      BETR= XMAT(20+IDECA)
      CLCS= XMAT(21+IDECA)
      EPCS= XMAT(22+IDECA)
      CLBI= XMAT(23+IDECA)
      VF1(1)= XMAT(24+IDECA)
      VF1(2)= XMAT(25+IDECA)
      VF1(3)= XMAT(26+IDECA)
      VF2(1)= XMAT(27+IDECA)
      VF2(2)= XMAT(28+IDECA)
      VF2(3)= XMAT(29+IDECA)
      VF3(1)= XMAT(30+IDECA)
      VF3(2)= XMAT(31+IDECA)
      VF3(3)= XMAT(32+IDECA)
C
      IF(IIMPI.EQ.9) WRITE(IOIMP,2007) (XMAT(I),I=1,32+IDECA)
      IF(IIMPI.EQ.9) WRITE(IOIMP,2008) (IVAL(I),I=1,32+IDECA)
C
C
C  PETIT TEST SUR NU POUR CERTAINS CAS
C
      IF(MFR.EQ.3.AND.IFOUR.EQ.-2.AND.XNU.NE.0.D0) THEN
      KERRE=38
      RETURN
      ENDIF
C
C VALEURS PAR DEFAUT
C
C                  POUR LA TRACTION
C
      IF(IVAL( 5+IDECA).EQ.0) CTR1=YOUN*1.2E-4
      IF(IVAL( 6+IDECA).EQ.0) ETR1=3.D0*CTR1/YOUN
      IF(IVAL( 7+IDECA).EQ.0) CTT1=0.D0
      IF(IVAL( 8+IDECA).EQ.0) ETT1=ETR1
      IF(IVAL( 9+IDECA).EQ.0) ERS1=0.D0
      IF(IVAL(10+IDECA).EQ.0) THEN
        CTR2=CTR1
        ETR2=ETR1
        CTT2=CTT1
        ETT2=ETT1
        ERS2=ERS1
      ELSE
        IF(IVAL(11+IDECA).EQ.0) ETR2=3.D0*CTR2/YOUN
        IF(IVAL(12+IDECA).EQ.0) CTT2=0.D0
        IF(IVAL(13+IDECA).EQ.0) ETT2=ETR2
        IF(IVAL(14+IDECA).EQ.0) ERS2=0.D0
      ENDIF
      IF(IVAL(15+IDECA).EQ.0) THEN
        CTR3=CTR1
        ETR3=ETR1
        CTT3=CTT1
        ETT3=ETT1
        ERS3=ERS1
      ELSE
      IF(IVAL(16+IDECA).EQ.0) ETR3=3.D0*CTR3/YOUN
      IF(IVAL(17+IDECA).EQ.0) CTT3=0.D0
      IF(IVAL(18+IDECA).EQ.0) ETT3=ETR3
      IF(IVAL(19+IDECA).EQ.0) ERS3=0.D0
      ENDIF
*
*
      IF(MFR.EQ.1.AND.(IFOUR.GE.-1.OR.IFOUR.EQ.-3)) THEN
C
        IF(IVAL(24+IDECA).EQ.0.AND.IVAL(27+IDECA).EQ.0
     &                        .AND.IVAL(30+IDECA).EQ.0) NVEC=0
        IF(IVAL(24+IDECA).NE.0.OR.IVAL(27+IDECA).NE.0
     &                        .OR.IVAL(30+IDECA).NE.0)  NVEC=1
        IF(IVAL(24+IDECA).NE.0.AND.IVAL(27+IDECA).NE.0) NVEC=2
C
        KAS=1
        IF(IVAL(27+IDECA).NE.0.AND.NVEC.EQ.1) KAS=2
        IF(IVAL(30+IDECA).NE.0.AND.NVEC.EQ.1) KAS=3
        IF(IFOUR.EQ.-3.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.0) THEN
          NVEC=1
          KAS=3
          VAR0(15)=0.D0
          VAR0(16)=0.D0
          VAR0(17)=1.D0
          VF3(1)=0.D0
          VF3(2)=0.D0
          VF3(3)=1.D0
        ENDIF
C
      ENDIF
C
      IF(IVAL(20+IDECA).EQ.0)  BETR=0.1D0
C
C VALEURS PAR DEFAUT POUR LE MODELE BETON CONTRAINTES PLANES
C
C                  POUR LA TRACTION
C
      IF(MFR.EQ.3.OR.MFR.EQ.9.OR.IFOUR.EQ.-2) THEN
        IFIS=0
        IF(IVAL(5+IDECA).NE.0.AND.IVAL(10+IDECA).NE.0) IFIS=1
        ANGL=0.D0
        IF(IVAL(24+IDECA).NE.0.AND.IVAL(25+IDECA).NE.0.AND.IFIS.EQ.1)
     .     ANGL=ATAN2(VF1(2),VF1(1))
C
C                  POUR LA COMPRESSION
C
        IF(IVAL(21+IDECA).EQ.0) CLCS=YOUN*1.2D-3
        IF(IVAL(22+IDECA).EQ.0) EPCS=10.D0*CLCS/YOUN
C
C                  BI-COMPRESSION
C
        IF(IVAL(23+IDECA).EQ.0) THEN
          REP=EPCS*YOUN/CLCS
          UMN=1.D0-XNU
          ALF=((REP-UMN-(SQRT(0.5D0*REP*UMN)))/(2.D0*REP-UMN))*0.95D0
          DDD=(1.D0-ALF)/(1.D0-2.D0*ALF)
          CLBI=DDD*CLCS
        ENDIF
      ENDIF
C
C INITIALISATION
C
      JEPRIN = 0
      UNIT=0.0174532925199432957692D0
      ANGLE=0.D0
      IF(IFIS.EQ.1) ANGLE=ANGL
C
      XLTR(1)=CTR1
      XLTR(2)=CTR2
      XLTR(3)=CTR3
      XLTT(1)=CTT1
      XLTT(2)=CTT2
      XLTT(3)=CTT3
      EPTR(1)=ETR1
      EPTR(2)=ETR2
      EPTR(3)=ETR3
      EPTT(1)=ETT1
      EPTT(2)=ETT2
      EPTT(3)=ETT3
      EPRS(1)=ERS1
      EPRS(2)=ERS2
      EPRS(3)=ERS3
C
C CALCUL ET TEST DES PARAMETRES DU BETON
C
C     CALCUL DES BRANCHES DESCENDANTES DANS LE DOMAINE DE LA TRACTION
C     POUR LE MODELE BETON CONTRAINTES PLANES
C
      IF(MFR.EQ.3.OR.MFR.EQ.9.OR.IFOUR.EQ.-2) THEN
C
        IF(IFIS.EQ.0) THEN
          R=ABS(CTR1-CTR2)
          IF(R.GT.1.D-7) THEN
            KERRE=441
            RETURN
          ENDIF
        ENDIF
C
        EP1=ETR1-VAR0(5)
        EP2=ETR2-VAR0(6)
C
        IF(EP1.LE.1.D-10) THEN
          CTR1=0.D0
          PENTT1=0.D0
        ENDIF
C
        IF(EP2.LE.1.D-10) THEN
          CTR2=0.D0
          PENTT2=0.D0
        ENDIF
C
        EP1=ETR1-CTR1/YOUN/(1-XNU)
        EP2=ETR2-CTR2/YOUN/(1-XNU)
C
        IF(EP1.LT.1.D-10) THEN
          KERRE=438
          RETURN
        ENDIF
C
        IF(EP2.LT.1.D-10) THEN
          KERRE=439
          RETURN
        ENDIF
C
        IF(EP1.GT.1.D-10) PENTT1=-CTR1/ETR1
        IF(EP2.GT.1.D-10) PENTT2=-CTR2/ETR2
C
C     CALCUL DES PARAMETRES DU DRUCKER POUR LE MODELE
C     BETON CONTRAINTES PLANES
C
        DI1=CLCS-CLBI
        IF(DI1.GE.0.D0) THEN
          KERRE=443
          RETURN
        ENDIF
C
        DI2=CLCS-2.D0*CLBI
        ALFAD2=DI1/DI2
        DPELA2=(1.D0-ALFAD2)*CLCS
C
        R=DPELA2/(1.D0+ALFAD2)
        IF(R.LT.CTR1.OR.R.LT.CTR2.AND.IIMPI.EQ.9) WRITE(IOIMP,900)
C
        R=ABS(PENTT1-PENTT2)
        IF(R.GT.1.D-7.AND.CTR1.NE.0.D0.AND.CTR2.NE.0.D0.
     .     AND.IIMPI.EQ.9) WRITE(IOIMP,901)
C
        EPSA=CLCS/YOUN
        PENTE2=-CLCS/(EPCS-EPSA)
        PENTE2=(YOUN*PENTE2)/(YOUN-PENTE2)
        PENTE2=PENTE2*(ALFAD2-1.D0)*(ALFAD2-1.D0)
C
      ENDIF
C
      IF(BETR.GT.1.D0) THEN
        KERRE=442
        RETURN
       ENDIF
C
C     CALCUL DES CONSTANTES
C
      EPS1=CTR1/YOUN
      EPS2=CTR2/YOUN
      EPS3=CTR3/YOUN
C
      TRTRAC=CTR1+CTR2+CTR3
C
      SIGT=TRTRAC*0.333333333333333333333333333333333D0
C
C     TEST SUR LES VALEURS DES PARAMETRES
C
      IF(MFR.EQ.3.OR.MFR.EQ.9.OR.IFOUR.EQ.-2) THEN
C
        IF(ETR1.LT.EPS1) THEN
          KERRE=449
          REAERR(1)=ETR1
          REAERR(2)=EPS1
          RETURN
        ENDIF
C
        IF(ETR2.LT.EPS2) THEN
          KERRE=450
          REAERR(1)=ETR2
          REAERR(2)=EPS2
          RETURN
        ENDIF
C
        IF(EPCS.LT.EPSA) THEN
          KERRE=444
          REAERR(1)=EPCS
          REAERR(2)=EPSA
          RETURN
        ENDIF
C
        IF(CLCS.LT.SIGT) THEN
          KERRE=445
          REAERR(1)=CLCS
          REAERR(2)=SIGT
          RETURN
        ENDIF
C
        ECR2=(2.D0*YOUN*(0.5D0-ALFAD2)*(0.5D0-ALFAD2))/(1.D0-XNU)
        IF(ABS(PENTE2).GE.ECR2) THEN
          KERRE=458
          REAERR(1)=PENTE2
          REAERR(2)=ECR2
          RETURN
        ENDIF
      ENDIF
C
      IF(MFR.EQ.1.AND.(IFOUR.GE.-1.OR.IFOUR.EQ.-3)) THEN
C
        IF(CTR1.LT.CTT1) THEN
          KERRE=446
          REAERR(1)=CTR1
          REAERR(2)=CTT1
          RETURN
        ENDIF
C
        IF(CTR2.LT.CTT2) THEN
          KERRE=447
          REAERR(1)=CTR2
          REAERR(2)=CTT2
          RETURN
        ENDIF
C
        IF(CTR3.LT.CTT3) THEN
          KERRE=448
          REAERR(1)=CTR3
          REAERR(2)=CTT3
          RETURN
        ENDIF
C
        IF(ETR1.LT.EPS1) THEN
          KERRE=449
          REAERR(1)=ETR1
          REAERR(2)=EPS1
          RETURN
        ENDIF
C
        IF(ETR2.LT.EPS2) THEN
          KERRE=450
          REAERR(1)=ETR2
          REAERR(2)=EPS2
          RETURN
        ENDIF
C
        IF(ETR3.LT.EPS3) THEN
          KERRE=451
          REAERR(1)=ETR3
          REAERR(2)=EPS3
          RETURN
        ENDIF
C
        IF(ETR1.LT.ETT1.OR.ETT1.LT.EPS1) THEN
          KERRE=452
          REAERR(1)=ETR1
          REAERR(2)=ETT1
          REAERR(3)=EPS1
          RETURN
        ENDIF
C
        IF(ETR2.LT.ETT2.OR.ETT2.LT.EPS2) THEN
          KERRE=453
          REAERR(1)=ETR2
          REAERR(2)=ETT2
          REAERR(3)=EPS2
          RETURN
        ENDIF
C
        IF(ETR3.LT.ETT3.OR.ETT3.LT.EPS3) THEN
          KERRE=454
          REAERR(1)=ETR3
          REAERR(2)=ETT3
          REAERR(3)=EPS3
          RETURN
        ENDIF
C
        IF(ETR1.LT.ERS1) THEN
          KERRE=455
          REAERR(1)=ETR1
          REAERR(2)=ERS1
          RETURN
        ENDIF
C
        IF(ETR2.LT.ERS2) THEN
          KERRE=456
          REAERR(1)=ETR2
          REAERR(2)=ERS2
          RETURN
        ENDIF
C
        IF(ETR3.LT.ERS3) THEN
          KERRE=457
          REAERR(1)=ETR3
          REAERR(2)=ERS3
          RETURN
        ENDIF
C
      ENDIF
C
C  CALCUL DE L INCREMENT DE CONTRAINTES
C
      CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
     1 VALCAR,N2EL,N2PTEL,MFR,IFOU,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 998
       ENDIF
*
C
C ECOULEMENT PLASTIQUE
C
  333 MCOD=1
      CALL VISAVI(SIG0,DSIGT,VAR0,SIGMA,DSIGMA,SPHER,AUXIL,
     .        SIGF,DEFP,VARF,SIGFIN,DEFPLA,
     .        DSIGZE,ICENT2,MCOD,IBOU,MFR,NSTRS,XCAR,CMATE,ecou,necou)
      IF(ITYP.EQ.0) THEN
        KERRE=269
        RETURN
      ENDIF
*
C
C IMPRESSION DES PARAMETRES DU MODELE
C
      IF(IIMPI.EQ.9) THEN
        WRITE(IOIMP,1000)
        WRITE(IOIMP,1001) YOUN
        WRITE(IOIMP,1002) XNU
        WRITE(IOIMP,1003)
        IF(ITYP.EQ.2.OR.ITYP.EQ.6.OR.ITYP.EQ.7) THEN
          WRITE(IOIMP,1004) CTR1,CTR2
          WRITE(IOIMP,1005) ETR1,ETR2
          WRITE(IOIMP,1006) VAR0(5),VAR0(6)
          WRITE(IOIMP,1007) (ANGLE/UNIT)
        ENDIF
        IF(MFR.EQ.1.AND.(IFOUR.GE.-1.OR.IFOUR.EQ.-3)) THEN
          WRITE(IOIMP,1008) CTR1,CTR2,CTR3
          WRITE(IOIMP,1009) CTT1,CTT2,CTT3
          WRITE(IOIMP,1010) ETT1,ETT2,ETT3
          WRITE(IOIMP,1011) ETR1,ETR2,ETR3
          WRITE(IOIMP,1012) ERS1,ERS2,ERS3
          WRITE(IOIMP,1013) VAR0(5),VAR0(6),VAR0(7)
          IF((KAS.EQ.1.AND.NVEC.EQ.1).OR.NVEC.EQ.2)
     .      WRITE(IOIMP,1014) (VF1(I),I=1,3)
          IF((KAS.EQ.2.AND.NVEC.EQ.1).OR.NVEC.EQ.2)
     .      WRITE(IOIMP,1015) (VF2(I),I=1,3)
          IF((KAS.EQ.3.AND.NVEC.EQ.1).OR.NVEC.EQ.2)
     .      WRITE(IOIMP,1016) (VF3(I),I=1,3)
        ENDIF
        WRITE(IOIMP,1017) BETR
        IF(ITYP.EQ.2.OR.ITYP.EQ.6.OR.ITYP.EQ.7) WRITE(IOIMP,1018)
        IF(MFR.EQ.1.AND.(IFOUR.GE.-1.OR.IFOUR.EQ.-3)) WRITE(IOIMP,1019)
        IF(ITYP.EQ.2.OR.ITYP.EQ.6.OR.ITYP.EQ.7) THEN
          WRITE(IOIMP,1020)
          WRITE(IOIMP,1021) CLCS,EPCS
          WRITE(IOIMP,1022) CLBI
        ENDIF
      ENDIF
C
C CAS DES CONTRAINTES PLANES :
C             IFOUR = -2
C AVEC DEUX TYPES DE FORMULATION MECANIQUE :
C          CAS DES COQUES :             ITYP = 2 ==> ALFAH = 0
C                                   OU  ITYP = 7 ==> ALFAH = 0
C          CAS DES CONTRAINTES PLANES : ITYP = 6
C
      IF(ITYP.EQ.2.OR.ITYP.EQ.6.OR.ITYP.EQ.7) THEN
C
C DANS LE CAS DES COQUES ITYP = 2  , NOUS METTONS ALFAH = 0
C
        IF(ITYP.EQ.2.OR.ITYP.EQ.7) ALFAH=0.D0
C
C INITIALISATIONS DES PARAMETRES
C
        IF(CTR1.GT.0.D0) RT1=(1.D0-VAR0(2))*CTR1
        IF(CTR1.LE.0.D0) RT1=0.D0
        IF(CTR2.GT.0.D0) RT2=(1.D0-VAR0(3))*CTR2
        IF(CTR2.LE.0.D0) RT2=0.D0
        XLAMBD(1)=VAR0(5)
        XLAMBD(2)=VAR0(6)
        XLAMBD(3)=VAR0(8)
        IF(IVAL(24+IDECA).EQ.0) VF1(1)=VAR0(9)
        IF(IVAL(25+IDECA).EQ.0) VF1(2)=VAR0(10)
C
        IF(IFIS.EQ.0.AND.(XLAMBD(1).GT.0.D0.OR.XLAMBD(2).GT.0D0)) THEN
          IFIS=1
          ANGLE=ATAN2(VF1(2),VF1(1))
        ENDIF
C
        DO 200 IBA=1,IBOU
        STOT(IBA)=SIGMA(IBA)+DSIGMA(IBA)
  200   CONTINUE
C
C ECOULEMENT PLASTIQUE
C
        CALL ECBECP(SIGMA,DSIGMA,XLAMBD,DEFPLA,YOUN,XNU,
     .              IFIS,ANGLE,BETR,RT1,PENTT1,RT2,PENTT2,
     .              DPELA2,ALFAD2,PENTE2,IDAM,SIGFIN,ITYP,KERRE)
C
        IF(IIMPI.EQ.9) THEN
          WRITE(IOIMP,2000)
          WRITE(IOIMP,2001) (SIGMA(I),I=1,IBOU)
          WRITE(IOIMP,2002) (DSIGMA(I),I=1,IBOU)
          WRITE(IOIMP,2003) (STOT(I),I=1,IBOU)
          WRITE(IOIMP,2004) (SIGFIN(I),I=1,IBOU)
          WRITE(IOIMP,2005) (DEFPLA(I),I=1,IBOU)
          WRITE(IOIMP,2006) (XLAMBD(I),I=1,6)
        ENDIF
C
        IF(KERRE.NE.0) THEN
           IF(JEPRIN.EQ.0) THEN
             KERRE=0
             JEPRIN=1
             IIMPI=9
             GO TO 333
           ELSE
             IIMPI=0
             RETURN
           ENDIF
        ENDIF
C
C PAS DE PLASTICITE COMPORTEMENT ELASTIQUE
C
        IF(IDAM.EQ.0) THEN
          DO 300 IBA=1,IBOU
          SIGFIN(IBA)=STOT(IBA)
          DEFPLA(IBA)=0.D0
  300     CONTINUE
        ENDIF
C
C NOUS AVONS ENDOMMAGE LE MATERIAU
C
C MISE A JOUR DES VARIABLES INTERNES
C
        VARF(1)=SQRT(XLAMBD(1)*XLAMBD(1)+XLAMBD(2)*XLAMBD(2)+
     .                XLAMBD(3)*XLAMBD(3))
        IF(CTR1.GT.0.D0) VARF(2)=1.D0-RT1/CTR1
        IF(CTR1.LE.0.D0) VARF(2)=1.D0
        IF(CTR2.GT.0.D0) VARF(3)=1.D0-RT2/CTR2
        IF(CTR2.LE.0.D0) VARF(3)=1.D0
        VARF(5)=XLAMBD(1)
        VARF(6)=XLAMBD(2)
        VARF(8)=XLAMBD(3)
        VARF(9)=COS(ANGLE)
        VARF(10)=SIN(ANGLE)
C
C     CAS DES DEFORMATIONS PLANES , AXISYMETRIQUE ET TRIDIME
C
      ELSEIF (ITYP.EQ.1) THEN
C
C       INITIALISATIONS DES PARAMETRES
C
        IF(CTR1.GT.0.D0) RT(1)=(1.D0-VAR0(2))*CTR1
        IF(CTR1.LE.0.D0) RT(1)=0.D0
        IF(CTR2.GT.0.D0) RT(2)=(1.D0-VAR0(3))*CTR2
        IF(CTR2.LE.0.D0) RT(2)=0.D0
        IF(CTR3.GT.0.D0) RT(3)=(1.D0-VAR0(4))*CTR3
        IF(CTR3.LE.0.D0) RT(3)=0.D0
        OUVER(1)=VAR0(5)
        OUVER(2)=VAR0(6)
        OUVER(3)=VAR0(7)
        IF(IVAL(24+IDECA).EQ.0) VF1(1)=VAR0(9)
        IF(IVAL(25+IDECA).EQ.0) VF1(2)=VAR0(10)
        IF(IVAL(26+IDECA).EQ.0) VF1(3)=VAR0(11)
        IF(IVAL(27+IDECA).EQ.0) VF2(1)=VAR0(12)
        IF(IVAL(28+IDECA).EQ.0) VF2(2)=VAR0(13)
        IF(IVAL(29+IDECA).EQ.0) VF2(3)=VAR0(14)
        IF(IVAL(30+IDECA).EQ.0) VF3(1)=VAR0(15)
        IF(IVAL(31+IDECA).EQ.0) VF3(2)=VAR0(16)
        IF(IVAL(32+IDECA).EQ.0) VF3(3)=VAR0(17)
C
        IF(NVEC.EQ.2) THEN
          NBVECD=NVEC
        ELSE
          NBVECD=0
          CALL NORME(VF1,P1)
          CALL NORME(VF2,P2)
          CALL NORME(VF3,P3)
          IF(P1.GT.0.D0) NBVECD=NBVECD+1
          IF(P2.GT.0.D0) NBVECD=NBVECD+1
          IF(P3.GT.0.D0) NBVECD=NBVECD+1
          IF(NBVECD.GT.2) NBVECD=2
        ENDIF
C
C       CALCUL DE DEFORMATION PLASTIQUE
C
        CALL EPSIG(DSIGMA,DEPS,IFOUR,YOUN,XNU,ITYP,ORMAT,XCAR)
C
        IF(IIMPI.EQ.9) THEN
          WRITE(IOIMP,*) 'AVANT L APPEL A TENSI3 AVANT L APPEL A AJUSTE'
          WRITE(IOIMP,*) 'NBVECD',NBVECD
          WRITE(IOIMP,*) 'ANGLE ',(ANGLE/UNIT)
          WRITE(IOIMP,*) 'VF1   ',(VF1(I),I=1,3)
          WRITE(IOIMP,*) 'VF2   ',(VF2(I),I=1,3)
          WRITE(IOIMP,*) 'VF3   ',(VF3(I),I=1,3)
        ENDIF
C
        MODE=1
        CALL AJUSTE (VF1,VF2,VF3,XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER,
     .               W1,W2,W3,YLTR,DETR,YLTT,DETT,DERS,ST,FISSU,
     .               ANGLE,NBVECD,KAS,MODE)
C
        CALL TENSI3 (SIGMA,DSIGMA,DEPS,YOUN,XNU,BETR,
     .               W1,W2,W3,ANGLE,NBVECD,
     .               YLTR,DETR,YLTT,DETT,DERS,ST,FISSU,
     .               SIGFIN,DEFPLA,KERRE)
C
        IF(IIMPI.EQ.9) THEN
          WRITE(IOIMP,*) 'APRES L APPEL A TENSI3 AVANT L APPEL A AJUSTE'
          WRITE(IOIMP,*) 'NBVECD',NBVECD
          WRITE(IOIMP,*) 'ANGLE ',(ANGLE/UNIT)
          WRITE(IOIMP,*) 'W1    ',(W1(I),I=1,3)
          WRITE(IOIMP,*) 'W2    ',(W2(I),I=1,3)
          WRITE(IOIMP,*) 'W3    ',(W3(I),I=1,3)
        ENDIF
C
        MODE=2
        CALL AJUSTE (VF1,VF2,VF3,XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER,
     .               W1,W2,W3,YLTR,DETR,YLTT,DETT,DERS,ST,FISSU,
     .               ANGLE,NBVECD,KAS,MODE)
C
        IF(IIMPI.EQ.9) THEN
          WRITE(IOIMP,*) 'KAS   ',KAS
          WRITE(IOIMP,*) 'SIGMA ',(SIGMA(I),I=1,IBOU)
          WRITE(IOIMP,*) 'DSIGMA',(DSIGMA(I),I=1,IBOU)
          WRITE(IOIMP,*) 'DEPS ',(DEPS(I),I=1,IBOU)
          WRITE(IOIMP,*) 'SIGFIN',(SIGFIN(I),I=1,IBOU)
          WRITE(IOIMP,*) 'DEFPLA',(DEFPLA(I),I=1,IBOU)
          WRITE(IOIMP,*) 'OUVER ',(OUVER(I),I=1,3)
          WRITE(IOIMP,*) 'RT    ',(RT(I),I=1,3)
          WRITE(IOIMP,*) 'NBVECD',NBVECD
          WRITE(IOIMP,*) 'ANGLE ',(ANGLE/UNIT)
          WRITE(IOIMP,*) 'VF1   ',(VF1(I),I=1,3)
          WRITE(IOIMP,*) 'VF2   ',(VF2(I),I=1,3)
          WRITE(IOIMP,*) 'VF3   ',(VF3(I),I=1,3)
        ENDIF
C
        IF(KERRE.NE.0) THEN
           IF(JEPRIN.EQ.0) THEN
             KERRE=0
             JEPRIN=1
             IIMPI=9
             GO TO 333
           ELSE
             IIMPI=0
             RETURN
           ENDIF
        ENDIF
C
C MISE A JOUR DES VARIABLES INTERNES
C
        VARF(1)=SQRT(OUVER(1)*OUVER(1)+OUVER(2)*OUVER(2)+
     .                OUVER(3)*OUVER(3))
        IF(CTR1.GT.0.D0) VARF(2)=1.D0-RT(1)/CTR1
        IF(CTR1.LE.0.D0) VARF(2)=1.D0
        IF(CTR2.GT.0.D0) VARF(3)=1.D0-RT(2)/CTR2
        IF(CTR2.LE.0.D0) VARF(3)=1.D0
        IF(CTR3.GT.0.D0) VARF(4)=1.D0-RT(3)/CTR3
        IF(CTR3.LE.0.D0) VARF(4)=1.D0
        VARF(5)=OUVER(1)
        VARF(6)=OUVER(2)
        VARF(7)=OUVER(3)
        VARF( 9)=VF1(1)
        VARF(10)=VF1(2)
        VARF(11)=VF1(3)
        VARF(12)=VF2(1)
        VARF(13)=VF2(2)
        VARF(14)=VF2(3)
        VARF(15)=VF3(1)
        VARF(16)=VF3(2)
        VARF(17)=VF3(3)
      ELSE
        KERRE=463
        RETURN
      ENDIF
C
      MCOD=2
      CALL VISAVI(SIG0,DSIGT,VAR0,SIGMA,DSIGMA,SPHER,AUXIL,
     .        SIGF,DEFP,VARF,SIGFIN,DEFPLA,
     .        DSIGZE,ICENT2,MCOD,IBOU,MFR,NSTRS,XCAR,CMATE,ecou,necou)
 
C
C LES FORMATS D IMPRESSION
C
  900 FORMAT(1X,'ATTENTION LES CRITERES DE TRACTION SERONT INACTIFS',/,
     * 1X,'LIMITE EN TRACTION TROP ELEVE SEUL LE DRUCKER EST ACTIF',/)
  901 FORMAT(1X,'ATTENTION DEFORMATIONS A RUPTURE ET LIMITES EN',/,
     * 1X,'TRACTION SONT INCOMPATIBLES POUR AVOIR UN MATERIAU',/,
     * 1X,'ISOTROPE INITIALEMENT',/)
C
 1000 FORMAT(////,31X,'MATERIAU BETON',//)
 1001 FORMAT(6X,'MODULE D''YOUNG',T51,'= ',1PE12.5)
 1002 FORMAT(6X,'COEF. DE POISSON',T51,'= ',1PE12.5)
 1003 FORMAT(/,1X,'DOMMAGE PAR TRACTION :',/)
 1004 FORMAT(6X,'CONTRAINTES LIMITES :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5/)
 1005 FORMAT(6X,'DEFORMATIONS A RUPTURE EN TRACTION :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5/)
 1006 FORMAT(6X,'OUVERTURES DES FISSURES :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5/)
 1007 FORMAT(6X,'ANGLE DE FISSURATION',T51,'= ',1PE12.5/)
 1008 FORMAT(6X,'CONTRAINTES LIMITES :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5,5X,'DIRECTION(3) = ',1PE12.5/)
 1009 FORMAT(6X,'CONTRAINTES DE TRANSITION :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5,5X,'DIRECTION(3) = ',1PE12.5/)
 1010 FORMAT(6X,'DEFORMATIONS DE TRANSITION :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5,5X,'DIRECTION(3) = ',1PE12.5/)
 1011 FORMAT(6X,'DEFORMATIONS A RUPTURE EN TRACTION :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5,5X,'DIRECTION(3) = ',1PE12.5/)
 1012 FORMAT(6X,'DEFORMATIONS RESIDUELLES :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5,5X,'DIRECTION(3) = ',1PE12.5/)
 1013 FORMAT(6X,'OUVERTURES DES FISSURES :',/
     *     11X,'DIRECTION(1) = ',1PE12.5,
     *      5X,'DIRECTION(2) = ',1PE12.5,5X,'DIRECTION(3) = ',1PE12.5/)
 1014 FORMAT(6X,'COMPOSANTES DU VECTEUR VF1 :',/
     *     11X,'DIRECTION(X) = ',1PE12.5,
     *      5X,'DIRECTION(Y) = ',1PE12.5,5X,'DIRECTION(Z) = ',1PE12.5/)
 1015 FORMAT(6X,'COMPOSANTES DU VECTEUR VF2 :',/
     *     11X,'DIRECTION(X) = ',1PE12.5,
     *      5X,'DIRECTION(Y) = ',1PE12.5,5X,'DIRECTION(Z) = ',1PE12.5/)
 1016 FORMAT(6X,'COMPOSANTES DU VECTEUR VF3 :',/
     *     11X,'DIRECTION(X) = ',1PE12.5,
     *      5X,'DIRECTION(Y) = ',1PE12.5,5X,'DIRECTION(Z) = ',1PE12.5/)
 1017 FORMAT(6X,'CISAILLEMENT RESIDUEL APRES FISSURATION  ',
     *     T51,'= ',1PE12.5/)
 1018 FORMAT(1X,'LA DECHARGE SERA EFFECTUEE AVEC LE MODULE ',
     *'ELASTIQUE DANS LE DOMAINE DE LA TRACTION',/)
 1019 FORMAT(1X,'LA DECHARGE SERA EFFECTUEE AVEC UN MODULE ',
     *'D ENDOMMAGEMENT DANS LE DOMAINE DE LA TRACTION',/)
 1020 FORMAT(/,1X,'DOMMAGE PAR COMPRESSION :',/)
 1021 FORMAT(6X,'COMPRESSION SIMPLE :',/
     *     11X,'CONTRAINTE LIMITE = ',1PE12.5,
     *      5X,'DEFORMATION A RUPTURE   = ',1PE12.5/)
 1022 FORMAT(6X,'COMPRESSION BIAXIALE :',/
     *     11X,'CONTRAINTE LIMITE = ',1PE12.5/)
C
 2000 FORMAT(1X,'RESULTATS DE L ECOULEMENT PLASTIQUE')
 2001 FORMAT(1X,'SIGMA  =',6(1X,1PE12.5))
 2002 FORMAT(1X,'DSIGMA =',6(1X,1PE12.5))
 2003 FORMAT(1X,'STOT   =',6(1X,1PE12.5))
 2004 FORMAT(1X,'SIGFIN =',6(1X,1PE12.5))
 2005 FORMAT(1X,'DEFPLA =',6(1X,1PE12.5))
 2006 FORMAT(1X,'XLAMBD =',6(1X,1PE12.5))
 2007 FORMAT(7(6(1X,E12.5),/))
 2008 FORMAT(7(6(1X,I12),/))
C
 998  RETURN
      END