Sources Esope | Cast3M

tufinc
C TUFINC    SOURCE    PV        11/03/07    21:18:39     6885
C TUFINC    SOURCE    BROC        94/05/09
C______________________________________________________________________
      SUBROUTINE TUFINC(DT,SIG,EPSV,VAR,XMAT,XCAR,EPSVPT,VARPT,
     &     NSTRS,NVARI,INPLAS,NCOMAT,KERR1)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C    Include contenant quelques constantes dont XPI :
-INC CCREEL
      DIMENSION SIG(*),EPSV(*),VAR(*),XMAT(*),XCAR(*),
     &     EPSVPT(*),VARPT(*)
C______________________________________________________________________
C CETTE ROUTINE CALCULE A PARTIR DES VALEURS INITIALES SIG VAR & EPSV
C                ET DE LA VARIATION DU TEMPS DT
C LES INCREMENTS DE DEFORMATIONS VISQUEUSES ET DE VARIABLES INTERNES
C____________________________________________________________________
 
      THETA = XCAR(9)/2
      EPAIS = XCAR(2)
      RAYOM = XCAR(1)-(EPAIS/2)
      AF1 = XMAT(6)
      AF2 = XMAT(7)
      ANG=XPI*THETA/180.0D0
 
      EPLU = VAR (1)
      EMIN = VAR (2)
      EEFF    = VAR (3)
      EPSH    = VAR (4)
      LL      = nint(VAR (5))
      DO 30 I=1,6
         EPSVPT(I)=0.0D0
 30   CONTINUE
      EPSCRP= EPSV(6)
      DO 50 I=1,NVARI
         VARPT(I)=0.0D0
 50   CONTINUE
      KERR1=0
 
C
C  CALCUL DES INCREMENTS DE VARIABLES INTERNES
C
      CALL TUFVAR(SIG,EPSCRP,EPLU,EMIN,EEFF,EPSH,LL,NSTRS)
      VARPT (1)   =  EPLU
      VARPT (2)   =  EMIN
      VARPT (3) =  EEFF
      VARPT (4) =  EPSH
      VARPT (5) =  LL
C
C CALCUL DES INCREMENTS DE EPSILON
C
 
C EVALUATION DE C* MOYENNANT ZAHOOR
C---- C* CALCULE QUE POUR DES CHARGEMENTS EN OUVERTURE DE FISSURE
C----ATTENTION SIG(6)&lt;0 SI MOMENT EN OUVERTURE
 
      IF (SIG(6).GT.(1.D-6).OR.SIG(1).LT.(-1.D-6)) THEN
         KERR1=729
         RETURN
      ENDIF
      XM0= 4*RAYOM*RAYOM*EPAIS*(COS(ANG/2)-0.5D0*SIN(ANG))
      IF (ABS(SIG(6)).GT.(0.99D0*SIG(1)*RAYOM)) THEN
         XLSLP1 = 1.D0
      ELSE
         XLAMDA = ABS(SIG(6))/(SIG(1)*RAYOM)
         XP0 = 2*RAYOM*EPAIS*(XPI-ANG - 2*ASIN(0.5D0*SIN(ANG)))
         XPP0=0.5D0*(-1*XLAMDA*RAYOM*XP0*XP0/XM0)
         XX=0.5D0*(((((XLAMDA*RAYOM*XP0*XP0/XM0)**2) + 4*XP0*XP0)**0.5D0
     $        ))
         XPP0=XPP0+XX
         XLSLP1=XLAMDA/(XLAMDA+1)
      ENDIF
      RAP=RAYOM/EPAIS
      AN=ANG/XPI
      CALL TUFH1(RAP,AF2,AN,XLSLP1,H1,KERR1)
      IF (KERR1.NE.0) THEN
         RETURN
      ENDIF
      IF (XLSLP1.GT.(0.99D0)) GOTO 55
      CETOI=AF1*(XPI-ANG)*RAYOM*(ANG/XPI)
      CETOI=CETOI*H1*((SIG(1)/XPP0)**(AF2+1))
      GO TO 60
 
 55   CONTINUE
      CETOI=AF1*XPI*((1-ANG/XPI)**2)*RAYOM
      CETOI=CETOI*H1*(ABS(SIG(6)/XM0)**(AF2+1))
 60   CONTINUE
      VARPT (7) =CETOI/DT
 
C RECHERCHE DE LA POSITION ALPHA DE LA FIBRE NEUTRE
 
      ALPH1=ANG/2
      ALPH2=ACOS(0.5D0*SIN(ANG))
      IF (ABS(SIG(6)).GT.(0.99D0*SIG(1)*RAYOM)) THEN
         ALPH=ALPH1
         GOTO 120
      ELSE
         X=XPI*ABS(SIG(6))/(SIG(1)*2*RAYOM)
         IF (X.LT.1.D-6) THEN
            ALPH=ALPH2
            GOTO 120
         ENDIF
      ENDIF
 
      F1=COS(ALPH1)-0.5D0*SIN(ANG)-X*(ALPH1/XPI-ANG/(2*XPI))
      F2=COS(ALPH2)-0.5D0*SIN(ANG)-X*(ALPH2/XPI-ANG/(2*XPI))
      ALPH3=ALPH1-((ALPH2-ALPH1)/(F2-F1))*F1
      F3=COS(ALPH3)-0.5D0*SIN(ANG)-X*(ALPH3/XPI-ANG/(2*XPI))
 
      ERR=F3
 
 70   CONTINUE
      IF ((F1*F3).LT.(0.0D0)) THEN
         ALPH2=ALPH3
         F2=F3
      ENDIF
      IF ((F2*F3).LT.(0.0D0)) THEN
         ALPH1=ALPH3
         F1=F3
      ENDIF
      ALPH3=ALPH1-((ALPH2-ALPH1)/(F2-F1))*F1
      F3=COS(ALPH3)-0.5D0*SIN(ANG)-X*(ALPH3/XPI-ANG/(2*XPI))
      ERR=COS(ALPH3)-0.5D0*SIN(ANG)-X*(ALPH3/XPI-ANG/(2*XPI))
      IF (ERR.GT.(1.00D-3)) GOTO 70
 
      ALPH=ALPH3
C EVALUATION DE L INCREMENT DE ROTATION DE FLUAGE
 
 120  CONTINUE
      YM0= 4*RAYOM*RAYOM*EPAIS*( COS(ALPH)-0.5D0*SIN(ANG))
      YP0= 2*RAYOM*EPAIS*(2*ALPH-ANG)
      IF (YM0.GE.1.0D-1) THEN
         EPSVPT(6)=CETOI/((SIG(6)/YM0)*RAYOM*(COS(ANG)+SIN(ALPH)))
      ELSE
         EPSVPT(6)=CETOI/((SIG(1)/YP0)*RAYOM*(COS(ANG)+SIN(ALPH)))
      ENDIF
      VARPT (6) = ABS(EPSVPT(6))
 
      RETURN
      END