Sources Esope | Cast3M

tufico
C TUFICO    SOURCE    CHAT      05/01/13    03:55:26     5004
      SUBROUTINE TUFICO(XM,XP,DELTAM,DELTAP,THETA,XM0,XP0)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=====================================================================
C      CE SOUS PROGRAMME SERT A TROUVER L INTERSECTION AVEC LA
C      SURFACE DE CHARGE
C
C      ENTREES : XM,XP   LES CONTRAINTES
C                DELTAM,DELTAP  L INCREMENT
C                THETA   ANGLE DE LA FISSURE
C
C      SORTIES : XM,XP  LES CONTRAINTES SUR LA SURFACE
C                DELTAM,DELTAP LE RESTE DE L INCREMENT
C======================================================================
      ZERO=0.D0
      PRECIS=1.D-3
      XL1=1.D0
      XL2=0.5D0
1     CONTINUE
      XM1=XM+XL1*DELTAM
      XP1=XP+XL1*DELTAP
      XM2=XM+XL2*DELTAM
      XP2=XP+XL2*DELTAP
      F1=CRIT1(XM1,XP1,THETA,XM0,XP0)
      F2=CRIT1(XM2,XP2,THETA,XM0,XP0)
      FP=(F2-F1)/(XL2-XL1)
      XL3=XL2-F2/FP
      XM3=XM+XL3*DELTAM
      XP3=XP+XL3*DELTAP
      F3=CRIT1(XM3,XP3,THETA,XM0,XP0)
      CRI=ABS(F3)
      CRU=ABS((XL3-XL2)/XL2)
      IF(CRI.GE.PRECIS.OR.CRU.GE.PRECIS) THEN
         XL1=XL2
         XL2=XL3
         GO TO 1
      ELSE
         XM=XM3
         XP=XP3
         DELTAM=(1.D0-XL3)*DELTAM
         DELTAP=(1.D0-XL3)*DELTAP
         RETURN
      ENDIF
      END