Sources Esope | Cast3M

xxcree
C XXCREE    SOURCE    CHAT      05/01/13    04:15:51     5004
      SUBROUTINE XXCREE(TAU,SIG,EPSV,VAR,SIGD,EPSVD,VARD,EPSTHD,
     &DSPT,XMAT,XMAINF,XMASUP,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,
     &NC,DD,DDV,DDINV,YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA,IFOURB,
     &INDIC,TI,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
C-----------------------------------------------------------------------
C Objet: Cette subroutine calcule les derivees des variables internes
C        pour un materiau viscoplastique a endommagement et ecrouissage
C        isotrope en regime anisotherme  de 2 manieres au choix suivant
C        la valeur de ITEST,ITHHER
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
C Entree: TAU pas de temps
C         TI temperature au debut du pas
C         TPOINT derivee de la temperature
C         TINF et TSUP bornes entre lesquelles TI est comprise
C         SIG(NSTRS) tenseur des contraintes
C         EPSV(NSTRS) tenseur des deformations
C         VAR(NVARI) tableau contenant les variables internes
C           pilotant les equations
C           VAR(1)=p ; VAR(2)=r ;VAR(3)=D
C         EPSTHD  vitesse de dilatation thermique au debut du pas
C         DSPT(NSTRS,NSTRS) vitesse de deformation totale
C         XMAT(NCOMAT) tableau des parametres scalaires du materiau
C           a une temperature T donnee
C         XMAINF(NCOMAT) tableau des parametres scalaires du materiau
C           a la temperature TINF
C         XMASUP(NCOMAT) tableau des parametres scalaires du materiau
C           a la temperature TSUP
C           XMAT(1)=YOUNG ;XMAT(2)=XNU ;XMAT(3)=n
C           XMAT(4)=m ;XMAT(5)=KK; XMAT(6)=ALPHA
C           XMAT(7)=BETA ;XMAT(8)=r; XMAT(9)=A ;
C           XMAT(10)=EVOL ;XMAT(11)=ALPHAT
C           XMAT(12)=RHO; XMAT(13)=SIGY
C         FKX(NKX) tableau de la fonction k(X,T) contenant les courbes
C           de k a differentes temperatures T1,T2,T3,...
C         NPTEUR(NC) tableau de pointeurs sur les differentes courbes
C           de la fonction k
C         MFR indice de la formulation mecanique(seulement massif
C           ou coque pour les materiaux endommageables
C         ICARA nombre de caracteristiques geometriques des elements
C           finis
C         XCAR(ICARA) tableau des caracteristiques geometriques des
C           elements finis
C         IFOURB= -2 EN CONTR. PLANES
C                 -1 EN DEFORM. PLANES
C                  0 EN AXISYMETRIE
C                  1 EN SERIE DE FOURIER
C                  2 EN TRIDIM
C         INDIC=0, 1 OU -1 pour plasticite avec endommagement
C              =2 OU -2 pour viscoplasticite avec endommagement
C         ITEST = 0 pas uniformite des listes de temperatures pour tous les
C           coefficients non lineaires
C           d'ou interpolation sur les coefficients du materiau
C               = 1 uniformite des listes de temperatures pour tous les
C           coefficients non lineaires
C           d'ou moyenne ponderee sur la variable elle-meme
C           ex: D(T)=A(T)*K**B(T)
C               T=TETA*TINF+(1-TETA)*TSUP
C           si ITEST=0 on remplace A(T) par (TETA*A(TINF)+(1-TETA))*A(TSUP)
C                                et B(T) par (TETA*B(TINF)+(1-TETA))*B(TSUP)
C           si ITEST=1 D(T)=TETA*D(TINF)+(1-TETA)*D(TSUP)
C         ITHHER = 0 pas de chargement thermique et materiau constant
C                = 1 chargement thermique et materiau constant
C                = 2 chargement thermique et materiau(T)
C------------------------------------------------------------------------
C
C------------------------------------------------------------------------
C Sortie: EPSVD(NSTRS) derivee du tenseur des deformations
C         VARD(NVARI) tableau contenant les derivees des variables
C           internes
C         SIGD(NSTRS) derivee des contraintes
C         DD(NSTRS,NSTRS) matrice de Hooke  au debut du pas
C         DDV(NSTRS,NSTRS) derivee de DD
C         DDINV(NSTRS,NSTRS) inverse de DD
C------------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION XMAINF(*),XMASUP(*),XCAR(*)
      DIMENSION SIG(*),EPSV(*),VAR(*)
      DIMENSION SIGD(*),EPSVD(*),VARD(*),DDINV(NSTRS,*)
      DIMENSION FKX(*),NPTEUR(*),XMAT(*),DSPT(*),YOUNG(*),XNU(*)
      DIMENSION DD(NSTRS,*),DDV(NSTRS,*),EPSTHD(*),TRUC(*)
      DIMENSION VARD1(3),EPSVD1(6),SIGD1(6),VARD2(3),EPSVD2(6)
C
C----- le materiau est constant ou pas, on derive normalement les contraintes
C
      IFLAG=0
      IF ( (ITEST.EQ.1).AND.(ITHHER.EQ.2) ) THEN
C----- si le materiau depend de la temperature et si les listes sont identiques
           IF (TINF.NE.TSUP) THEN
C-------------- Moyenne ponderee sur les vitesses des variables
                IFLAG=1
                TETA=(TI-TSUP)/(TINF-TSUP)
                CALL DERIV(TAU,SIG,EPSV,VAR,SIGD1,EPSVD1,VARD1,EPSTHD,
     &           DSPT,XMAINF,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,NC,
     &          DD,DDV,DDINV,YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA,
     &          IFOURB,INDIC,TINF,TPOINT,ITHHER,TRUC,NCOURB)
                DO 10 I=1,NVARI
10                     VARD2(I)=TETA*VARD1(I)
                     DO 20 I=1,NSTRS
20                     EPSVD2(I)=TETA*EPSVD1(I)
                CALL DERIV(TAU,SIG,EPSV,VAR,SIGD1,EPSVD1,VARD1,EPSTHD,
     &           DSPT,XMASUP,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,NC,
     &           DD,DDV,DDINV,YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA,
     &           IFOURB,INDIC,TSUP,TPOINT,ITHHER,TRUC,NCOURB)
                     DO 30 I=1,NVARI
30                     VARD2(I)=VARD2(I)+(1.D0-TETA)*VARD1(I)
                     DO 40 I=1,NSTRS
40                     EPSVD2(I)=EPSVD2(I)+(1.D0-TETA)*EPSVD1(I)
           ENDIF
      ENDIF
C
      CALL DERIV(TAU,SIG,EPSV,VAR,SIGD,EPSVD,VARD,EPSTHD,
     &DSPT,XMAT,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,NC,DD,DDV,DDINV,
     &YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA,IFOURB,INDIC,
     &TI,TPOINT,ITHHER,TRUC,NCOURB)
C
      IF (IFLAG.EQ.0) GOTO 100
C
                DO 50 I=1,NVARI
50                     VARD(I)=VARD2(I)
                DO 60 I=1,NSTRS
60                     EPSVD(I)=EPSVD2(I)
C
      CALL ZDANUL(SIGD,NSTRS)
      DEN=1.D0-VAR(3)
      DO 90 I=1,NSTRS
        DO 95 J=1,NSTRS
        SIGD(I)=SIGD(I)+(TPOINT*(DD(I,J)*SIG(J)))
95    CONTINUE
        SIGD(I)=SIGD(I)-((VARD(3)/DEN)*SIG(I))
90    CONTINUE
      CALL ELAST1(1,IFOURB,VAR,NVARI,XMAT,NCOMAT,YUNGV,ENUV,
     &XCAR,ICARA,MFR,NSTRS,DD,DDV,KERRE,INDIC,ITHHER)
      DO 80 I=1,NSTRS
        DO 85 J=1,NSTRS
        SIGD(I)=SIGD(I)+ DD(I,J)*( DSPT(J)-EPSVD(J)-EPSTHD(J) )
85    CONTINUE
80    CONTINUE
C
 100  CONTINUE
      RETURN
      END