Sources Esope | Cast3M

tufiec
C TUFIEC    SOURCE    CB215821  16/04/21    21:18:32     8920
      SUBROUTINE TUFIEC(XM,XP,DELTAM,DELTAP,THETA,XJP,EP,FIP,
     &     DLAM1,DLAM2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
     &     THETA0,KERRE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=====================================================================
C    CE SOUS PROGRAMME REALISE L ECOULEMENT PLASTIQUE
C      SANS PROPAGATION
C    IL EST APPELE PAR TUFIPA
C
C     ENTREES : XM,XP CONTRAINTES SUR LE CRITERE
C               DELTAM,DELTAP INCREMENT EN ELASTIQUE
C               THETA ANGLE DE LA FISSURE
C               XJP VALEUR DE JP AU DEBUT
C               IRET REGION OU L ON SE TROUVE
C
C     SORTIES : XJP VALEUR DE JP A LA FIN
C               EP,FIP INCREMENT DE DEFORMATIONS PLASTIQUES
C               DLAM1,DLAM2 INCREMENT DE LAMBDA
C=======================================================================
-INC CCREEL
*-
 
-INC PPARAM
-INC CCOPTIO
      SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
      DIMENSION DTUFI(2,2),CTUFI(2,2)
      XM0SS0=4.D0*RAYOM*RAYOM*EPAI
      XP0SS0=2.D0*XPI*RAYOM*EPAI
      NCOURB=SIG(/1)
      IBI=0
C
      IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'ENTREE DANS TUFIEC'
C
C  ON TESTE SUR QUELLE SURFACE ON DOIT PROJETTER
C
*    CAS DE L OUVERTURE
      IF(IRET.EQ.1) SENS=1.d0
*    CAS DE LA FERMETURE
      IF(IRET.EQ.3) SENS=-1.D0
*    POINTS SINGULIERS
      IF(IRET.NE.1.AND.IRET.NE.3) GOTO 2
C
C      POINTS NON SINGULIERS   ON FAIT L ECOULEMENT
C
      NBIT=0
      CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
C
C       1ERE ESTIMATION : TOUT EST ELASTIQUE
C
      EP1=0.D0
      FIP1=0.D0
      XM1=XM+DELTAM
      XP1=XP+DELTAP
      XLAM1=XLAM0
      CALL TRACTI(SIGMA1,XLAM1,SIG,XLAM,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
          KERRE=75
          RETURN
      ENDIF
      XM0=XM0SS0*SIGMA1
      XP0=XP0SS0*SIGMA1
      F1=CRIT1(XM1,XP1,THETA0,XM0,XP0)
 
C
C       2EME ESTIMATION : TOUT EST PLASTIQUE
C  SI BEAUCOUP TROP GRAND , ESTIMATION A PARTIR COURBE (M,PHIP)
C
      CALL TRACTI(PENTE1,XLAM1,SIG,XLAM,NCOURB,1,IBI)
      FIP21=ABS((DELTAM/XM0SS0)/PENTE1)
      FIP2=CTUFI(1,1)*DELTAM+CTUFI(1,2)*DELTAP
      AFIP2=SENS*FIP2
      IF (FIP21.LT.AFIP2) FIP2=FIP21*SENS
      FIP=CTUFI(1,1)*DELTAM+CTUFI(1,2)*DELTAP
      EP=CTUFI(1,2)*DELTAM+CTUFI(2,2)*DELTAP
      ALPH=EP/FIP
      EP2=ALPH*FIP2
 
      XLAM2=XLAM0+FIP2*SENS
      CALL TRACTI(SIGMA2,XLAM2,SIG,XLAM,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
          KERRE=75
          RETURN
      ENDIF
      XM0=XM0SS0*SIGMA2
      XP0=XP0SS0*SIGMA2
      DM2=DELTAM-DTUFI(1,1)*FIP2-DTUFI(1,2)*EP2
      DP2=DELTAP-DTUFI(1,2)*FIP2-DTUFI(2,2)*EP2
      XM2=XM+DM2
      XP2=XP+DP2
      F2=CRIT1(XM2,XP2,THETA0,XM0,XP0)
      IF (ABS(F2).LT.PRECIS) THEN
         FIP3=FIP2
         EP3=EP2
         XM3=XM2
         XP3=XP2
         SIGMA3=SIGMA2
         GOTO 20
      ENDIF
C
C    DETERMINATION DE DELTA LAMBDA PAR DICHOTOMIE
C
 11   CONTINUE
      NBIT=NBIT+1
C
C   TEST SUR LE NOMBRE D ITERATIONS INTERNES
C
      IF(NBIT.GT.50) THEN
         KERRE=2
         RETURN
      ENDIF
      FP=(FIP2-FIP1)/(F2-F1)
      FIP3=FIP1-FP*F1
      XLAM3=XLAM0+FIP3*SENS
      CALL TRACTI(SIGMA3,XLAM3,SIG,XLAM,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
          KERRE=75
          RETURN
      ENDIF
      XM0=XM0SS0*SIGMA3
      XP0=XP0SS0*SIGMA3
      EP3=ALPH*FIP3
      DM3=DELTAM-DTUFI(1,1)*FIP3-DTUFI(1,2)*EP3
      DP3=DELTAP-DTUFI(1,2)*FIP3-DTUFI(2,2)*EP3
      XM3=XM+DM3
      XP3=XP+DP3
      F3=CRIT1(XM3,XP3,THETA0,XM0,XP0)
C
C    TESTS DE CONVERGENCE
C
      IF (ABS(F3).LT.PRECIS) GOTO 20
C
      IF ((F1*F3).LT.0.D0) THEN
         FIP2=FIP3
         F2=F3
         GO TO 11
      ENDIF
      IF (((F1*F2).GT.0.D0).OR.((F3*F2).LT.0.D0)) THEN
         FIP1=FIP3
         F1=F3
         GO TO 11
      ENDIF
 20   CONTINUE
      IF(IRET.EQ.1) THEN
         DLAM1=FIP3
         DLAM2=0.D0
      ELSE
         DLAM1=0.D0
         DLAM2=FIP3*SENS
      ENDIF
      FIP=FIP3
      EP=EP3
      XM=XM3
      XP=XP3
C     DJP=RAYOM*COS(THETA)*DLAM1/XM0
C     DJP=RAYOM*COS(THETA)*FIP
C     DJP=SIGMA3*(DJP+EP)
      DJP=RAYOM*SIGMA3*(COS(THETA)+SIN(THETA/2.D0))*FIP*SENS
      XJP=XJP+DJP
      IF(IIMPI.EQ.999)THEN
         WRITE (IOIMP,*) 'NBRE ITERATIONS',NBIT
         WRITE (IOIMP,*)'SORTIE DE TUFIEC'
      ENDIF
      RETURN
C
C    CAS DES POINTS SINGULIERS DE LA SURFACE
C
 2    CONTINUE
      XM1=XM+DELTAM
      XP1=XP+DELTAP
      IF(IIMPI.EQ.999)WRITE(IOIMP,*)'ON EST SUR UNE POINTE'
      KERRE=21
C
C    ON CHERCHE OU L ON VA PROJETTER
C
C     CALL TUFINO(XM1,XP1,THETA,ISOR,XM0,XP0)
C     IF(ISOR.EQ.1) GO TO 10
C     IF(ISOR.EQ.3) GO TO 30
C
C   ON PROJETTE SUR LA POINTE
C
C     IF(IIMPI.EQ.999)WRITE(IOIMP,*)'ON PROJETTE SUR LA POINTE'
C     CALL TUFIHO(THETA,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
C     FIP=CTUFI(1,1)*DELTAM+CTUFI(1,2)*DELTAP
C     EP=CTUFI(1,2)*DELTAM+CTUFI(2,2)*DELTAP
C     DJP=SIGMA0*ABS(EP)
C     XJP=XJP+DJP
      IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'SORTIE DE TUFIEC'
      RETURN
      END