C TUFIPA    SOURCE    CHAT      05/01/13    03:56:03     5004           
      SUBROUTINE TUFIPA(XM,XP,DELTAM,DELTAP,THETA0,XJP,EP,FIP,
     $     DL1,DL2,PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,KERRE,THETA
     $     )
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C======================================================================
C      CE SOUS-PROGRAMME PILOTE L ECOULEMENT PLASTIQUE SANS
C      PROPAGATION POUR L ELEMENT TUYAU FISSURE
C       IL EST APPELE PAR TUFIPL
C     
C     ENTREES : XM,XP  POINT SUR LA SURFACE DE CHARGE
C               DELTAM,DELTAP  INCREMENT ELASTIQUE
C               THETA  ANGLE DE LA FISSURE
C               XJP  VALEUR DE JP AU DEBUT
C     
C     SORTIES : XM,XP CONTRAINTES A LA FIN
C               DELTAM,DELTAP CE QUI RESTE A ECOULER
C               XJP  VALEUR DE JP A LA FIN
C               EP,FIP  INCREMENT DE DEFORMATIONS PLASTIQUES
C               DL1,DL2  INCREMENT DE LAMBDA
C=======================================================================
-INC CCREEL
-INC CCOPTIO
      SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
      XMS=XM
      XPS=XP
      DMS=DELTAM
      DPS=DELTAP
      XJPS=XJP
      IF(IIMPI.EQ.999) WRITE (IOIMP,*)'ENTREE DANS TUFIPA'
C     
C   ON CHERCHE OU L ON VA ECOULER
C     
      CALL TUFINO(XM,XP,THETA0,IRET,XM0,XP0)
C     
C    ON REALISE L ECOULEMENT
C     
      CALL TUFIEC(XM,XP,DELTAM,DELTAP,THETA,XJP,EP,FIP,
     $     DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
     $     THETA0,KERRE)
      IF(KERRE.NE.0) RETURN
C     
C    ON VERIFIE OU ON ARRIVE
C     
      CALL TUFINO(XM,XP,THETA0,IR1,XM0,XP0)
      IF(IRET.EQ.IR1) THEN
         IF(IIMPI.EQ.999) WRITE (IOIMP,*)'SORTIE DE TUFIPA'
         DELTAM=0.D0
         DELTAP=0.D0
         RETURN
      ENDIF
C     
C    ON EST ALLE TROP LOIN ET ON CHERCHE LA PARTIE DE
C    L INCREMENT QUI NOUS RAMENE SUR LA POINTE
C     
      IF(IRET.EQ.1) THEN
         GOTO 1
      ELSE
         GOTO 2
      ENDIF
C     
C     
 1    CONTINUE
      XMU1=0.5D0
      XMU2=1.0D0
      XM1=XMS
      XP1=XPS
      DM1=XMU1*DMS
      DP1=XMU1*DPS
      CALL TUFIEC(XM1,XP1,DM1,DP1,THETA0,XJPS,EP,FIP,
     $     DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
     $     THETA0,KERRE)
      IF(KERRE.NE.0) RETURN
      F1=TUFP2(XM1,XP1,THETA0,XM0,XP0)
      F2=TUFP2(XM,XP,THETA0,XM0,XP0)
      TEST=F1*F2
      IF(TEST.GT.XZERO) THEN
         F2=F1
         F1=TUFP2(XMS,XPS,THETA0,XM0,XP0)
         XMU1=0.D0
         XMU2=0.5D0
      ENDIF
 10   CONTINUE
      FP=(F2-F1)/(XMU2-XMU1)
      XMU3=XMU2-F2/FP
      IF (IIMPI.EQ.999) WRITE(IOIMP,*)'MU',XMU3
      XM3=XMS
      XP3=XPS
      DM3=XMU3*DMS
      DP3=XMU3*DPS
      CALL TUFIEC(XM3,XP3,DM3,DP3,THETA0,XJPS,EP,FIP,
     $     DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
     $     THETA0,KERRE)
      IF(KERRE.NE.0) RETURN
      F3=TUFP2(XM3,XP3,THETA0,XM0,XP0)
      CRU=ABS((XMU3-XMU2)/XMU2)
      CRI=ABS(F3)
      IF(CRI.GE.PRECIS.OR.CRU.GE.PRECIS) THEN
         XMU1=XMU2
         XMU2=XMU3
         F1=F2
         F2=F3
         GO TO 10
      ELSE
         XJP=XJPS
         IF(XP3.GE.XZERO) THEN
            XP=XP0*(1.D0-THETA0/XPI)
            XM=-XM0*SIN(THETA0)/2.D0
            IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM
         ELSE
            XP=-XP0*(1.D0-THETA0/XPI)
            XM=XM0*SIN(THETA0)/2.D0
            IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM
         ENDIF
         DELTAM=(1.D0-XMU3)*DMS
         DELTAP=(1.D0-XMU3)*DPS
         IF(IIMPI.EQ.999)WRITE (IOIMP,*)'SORTIE DE TUFIPA'
         RETURN
      ENDIF
C     
 2    CONTINUE
      XMU1=0.5D0
      XMU2=1.0D0
      XM1=XMS
      XP1=XPS
      DM1=XMU1*DMS
      DP1=XMU1*DPS
      CALL TUFIEC(XM1,XP1,DM1,DP1,THETA0,XJPS,EP,FIP,
     $     DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
     $     THETA0,KERRE)
      IF(KERRE.NE.0) RETURN
      F1=TUFP1(XM1,XP1,THETA0,XM0,XP0)
      F2=TUFP1(XM,XP,THETA0,XM0,XP0)
      TEST=F1*F2
      IF(TEST.GT.XZERO) THEN
         F2=F1
         F1=TUFP1(XMS,XPS,THETA0,XM0,XP0)
         XMU1=0.D0
         XMU2=0.5D0
      ENDIF
 20   CONTINUE
      FP=(F2-F1)/(XMU2-XMU1)
      XMU3=XMU2-F2/FP
      IF (IIMPI.EQ.999) WRITE(IOIMP,*)'MU',XMU3
      XM3=XMS
      XP3=XPS
      DM3=XMU3*DMS
      DP3=XMU3*DPS
      CALL TUFIEC(XM3,XP3,DM3,DP3,THETA0,XJPS,EP,FIP,
     $     DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
     $     THETA0,KERRE)
      IF(KERRE.NE.0) RETURN
      F3=TUFP1(XM3,XP3,THETA0,XM0,XP0)
      CRI=ABS(F3)
      CRU=ABS((XMU3-XMU2)/XMU2)
      IF(CRI.GE.PRECIS.OR.CRU.GE.PRECIS) THEN
         XMU1=XMU2
         XMU2=XMU3
         F1=F2
         F2=F3
         GO TO 20
      ELSE
         XJP=XJPS
         IF(XP3.GE.XZERO) THEN
            XP=XP0*(1.D0-THETA0/XPI)
            XM=-XM0*SIN(THETA0)/2.D0
            IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM
         ELSE
            XP=-XP0*(1.D0-THETA0/XPI)
            XM=XM0*SIN(THETA0)/2.D0
            IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM
         ENDIF
         DELTAM=(1.D0-XMU3)*DMS
         DELTAP=(1.D0-XMU3)*DPS
         IF(IIMPI.EQ.999) WRITE(IOIMP,*)'SORTIE DE TUFIPA'
         RETURN
      ENDIF
      END