C COLBBB    SOURCE    OF166741  25/11/04    21:15:31     12349          
      SUBROUTINE COLBBB(WRK52,WRK53,WRK54,NVARI,iecou,necou)

C
C    calcule la deformation initiale a partir de la contrainte initiale
C    puis appelle la subroutine CLBCOM
C
C     variables en entree
C
C     WRK0,KRK1  pointeurs sur des segments de travail
C
C     NSTRS1      nombre de composantes dans les vecteurs des contraintes
C                                        et les vecteurs des deformations
C
C     NVARI      nombre de variables internes (doit etre egal a 4)
C
C     NMATT      nombre de constantes du materiau
C
C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
C                ISTEP=0 -----> calcul local
C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
C                               a partir des seuils moyennes
C
C KICH     XCARB <- XCAR      colbbb <- clbbbb

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC DECHE
-INC TECOU

      SEGMENT WRKK2
        REAL*8 EPSILI(NSTRSV)
      END SEGMENT

      SEGMENT WRK6
        REAL*8 SIG0S(NSTRS1)
      END SEGMENT

      DIMENSION DSIGT(6)
      PARAMETER (UN=1.D0)
*      PRINT*,'DANS COLBBB MFR=',iecou.MFR1,'IFOURB=',IFOURB,NIFOUR,ifour

      KERRE=0
      NSTRS1 = iecou.NSTRSS
      IF (iecou.MFR1 .EQ. 9) THEN
         NSTRSV=4
         IFOUR2=-2
      ELSE IF (iecou.MFR1 .EQ. 1) THEN
         NSTRSV=NSTRS1
         IF (IFOUR.NE. -2)THEN
            KERRE=57
            RETURN
         END IF
         IFOUR2=IFOUR
      ELSE
         KERRE=57
         RETURN
      END IF
*      PRINT*,'DANS COLBBB apres test MFR'
C
C     calcul de la matrice elastique
C
      CMATE = 'ISOTROPE'
      KCAS=2
      CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
      IF ( IRTD .NE. 1) THEN
         print*,'erreur dans dohmas'
         KERRE=56
         RETURN
      END IF
C
C      calcul de l'increment de contrainte
C
      CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
*       PRINT*,DEPST(1),DEPST(2),DEPST(3)
C
C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
C
      IF (iecou.MFR1 .EQ. 9) THEN
        EPAI=XCARB(1)
        SEGINI WRK6
        DO ISTRS=1,NSTRS1
          SIG0S(ISTRS)=SIG0(ISTRS)
        END DO
        SIG0(1)=SIG0S(1)/EPAI
        SIG0(2)=SIG0S(2)/EPAI
        SIG0(3)=0.D0
        SIG0(4)=SIG0S(3)/EPAI
      END IF
C
C     inversion de la matrice
C
      PREC=1.D-08
      SEGINI WRKK2
      CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
      IF (IRTD.NE.0)THEN
        print*,'erreur dans invalm'
        KERRE=56
        RETURN
      END IF
C
C     calcul des deformations du materiau elastique lineaire
C
      CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
C
C     modification pour tenir compte de l'endommagement
C
      DO 100 ISTRS=1,NSTRSV
         EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
100   CONTINUE
*      PRINT*,EPSILI(1),EPSILI(2),EPSILI(3)
C
C      appel a la routine CLBCOM
C
      icarbi=iecou.icara
      CALL COLBEC (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,icarbi)
*?      iecou.icara=icarbi
C
C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
C
      IF (iecou.MFR1 .EQ. 9) THEN
        DO ISTRS=1,NSTRS1
          SIG0(ISTRS)=SIG0S(ISTRS)
        END DO
        SIGF (1)=SIGF(1)*EPAI
        SIGF (2)=SIGF(2)*EPAI
        SIGF (3)=SIGF(4)*EPAI
        DO ISTRS=4,NSTRS1
          SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
        END DO
        SEGSUP WRK6
      END IF

      SEGSUP WRKK2

      RETURN
      END