C JFDDDD    SOURCE    CHAT      05/01/13    00:49:27     5004
      SUBROUTINE JFDDDD(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
     1                                 ICARA,KERRE,MFR,IFOURB,DT)
C
C    calcule la deformation initiale a partir de la contrainte initiale
C    puis appelle la subroutine CLBCOM
C
C
C     variables en entree
C
C     WRK0,KRK1  pointeurs sur des segments de travail
C
C     NSTRS      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
C     variables en sortie
C
C     VARF      variables internes finales dans WRK0
C
C     SIGF      contraintes finales dans WRK0
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
      SEGMENT WRK0
        REAL*8 XMAT(NMATT)
      ENDSEGMENT
*
      SEGMENT WRK1
        REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT
      SEGMENT WRKK2
         REAL*8 EPSILI(NSTRSV)
      END SEGMENT
*
      SEGMENT WRK5
        REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
      ENDSEGMENT
      SEGMENT WRK6
        REAL*8 SIG0S(NSTRS)
      END SEGMENT
*
      CHARACTER*8 CMATE
      REAL*8 DSIGT(6)
      PARAMETER (UN=1.D0)
      KERRE=0
C
      IF (MFR .EQ. 9) THEN
         NSTRSV=4
         IFOUR2=-2
      ELSE IF (MFR .EQ. 1) THEN
         NSTRSV=NSTRS
         IF (IFOURB.NE. -2)THEN
            KERRE=57
            RETURN
         END IF
         IFOUR2=IFOURB
      ELSE
         KERRE=57
         RETURN
      END IF
C
C     calcul de la matrice elastique
C
      CMATE = 'ISOTROPE'
      KCAS=2
      CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
      IF ( IRTD .EQ. 1) THEN
C
C      calcul de l'increment de contrainte
C
         CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
C
C
C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
C
         IF (MFR .EQ. 9) THEN
           EPAI=XCAR(1)
           SEGINI WRK6
           DO ISTRS=1,NSTRS
             SIG0S(ISTRS)=SIG0(ISTRS)
           END DO
           DO ISTRS=1,2
             SIG0(ISTRS)=SIG0(ISTRS)/EPAI
           END DO
           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.EQ.0)THEN
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
C
C      appel a la routine CLBCOM
C
            CALL  JFDECO (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
     1                                       ISTEP,ICARA,DT,KERRE)
C
C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
C
            IF (MFR .EQ. 9) THEN
               DO ISTRS=1,NSTRS
                  SIG0(ISTRS)=SIG0S(ISTRS)
               END DO
               DO ISTRS=1,2
                  SIGF (ISTRS)=SIGF(ISTRS)*EPAI
               END DO
               SIGF (3)=SIGF(4)*EPAI
               DO ISTRS=4,NSTRS
                  SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
               END DO
               SEGSUP WRK6
            END IF
         ELSE
             print*,'erreur dans invalm'
             KERRE=56
         END IF
      ELSE
         print*,'erreur dans dohmas'
         KERRE=56
      END IF
      SEGSUP WRKK2
      RETURN
      END