C TUFJDA    SOURCE    CHAT      05/01/13    03:56:29     5004           
      SUBROUTINE TUFJDA(THETA,XJP,RAYOM,JDA,THETA0,XK1,YOUN,KERRE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION DELTAA(130),XJLIS(130)
C     
C-----------------------------------------------------------------
C              PROPAGATION TUYAU FISSURE
C  CE SOUS-PROGRAMME EST APPELE PAR TUFPLA
C     
C  ENTREES:  XJP          VALEUR DE J PLASTIQUE AU POINT CONSIDERE
C            XJE          VALEUR DE J ELASTIQUE AU POINT CONSIDERE
C            RAYOM       RAYON MOYEN DU TUYAU
C            XJDA         COURBE (J-DA) DU MATERIAU
C            THETA0      ANGLE DE FISSURE INITIAL
C     
C  SORTIES:  THETA       ANGLE DE LA FISSURE DANS L'ETAT DE CHARGE
C                        CONSIDERE
C-----------------------------------------------------------------
C     
-INC SMEVOLL
-INC SMLREEL
C     
      DATA NCOMAX/130/
      KERRE=0
      MEVOLL=JDA
      SEGACT MEVOLL
      KEVOLL=IEVOLL(1)
      SEGACT KEVOLL
      MLREEL=IPROGX
      MLREE1=IPROGY
      SEGDES KEVOLL
      SEGACT MLREEL,MLREE1
      NBPOIX=PROG(/1)
      IF(NBPOIX.GT.NCOMAX+1) THEN
         CALL ERREUR(519)
C     
C   ERREUR
C     
         GO TO 777
      ENDIF
C     
C STOCKAGE DES DEUX LISTES DE REELS J ET DELTAA
C     
      DO 10 I=1,NBPOIX
         DELTAA(I)=PROG(I)
         XJLIS(I)=MLREE1.PROG(I)
 10   CONTINUE
      XJ1C=XJLIS(1)
      XJTOT=XJP+((XK1**2)/YOUN)
      IF(XJTOT.LT.XJ1C)THEN
C     
C               PAS DE PROPAGATION
C     
         THETA=THETA0
      ELSE
C     
C               PROPAGATION
C     
         IBI=0
         CALL TRACTI(DA,XJTOT,DELTAA,XJLIS,NBPOIX,2,IBI)
         IF(IBI.EQ.1) THEN
           KERRE=75
         ENDIF
         THETA=THETA0+((DA/RAYOM)/2.D0)
      ENDIF
C     
 777  CONTINUE
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
      RETURN
      END