1 : C XXCREE SOURCE CHAT 05/01/13 04:15:51 5004 2 : SUBROUTINE XXCREE(TAU,SIG,EPSV,VAR,SIGD,EPSVD,VARD,EPSTHD, 3 : &DSPT,XMAT,XMAINF,XMASUP,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX, 4 : &NC,DD,DDV,DDINV,YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA,IFOURB, 5 : &INDIC,TI,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB) 6 : C----------------------------------------------------------------------- 7 : C Objet: Cette subroutine calcule les derivees des variables internes 8 : C pour un materiau viscoplastique a endommagement et ecrouissage 9 : C isotrope en regime anisotherme de 2 manieres au choix suivant 10 : C la valeur de ITEST,ITHHER 11 : C----------------------------------------------------------------------- 12 : C 13 : C----------------------------------------------------------------------- 14 : C Entree: TAU pas de temps 15 : C TI temperature au debut du pas 16 : C TPOINT derivee de la temperature 17 : C TINF et TSUP bornes entre lesquelles TI est comprise 18 : C SIG(NSTRS) tenseur des contraintes 19 : C EPSV(NSTRS) tenseur des deformations 20 : C VAR(NVARI) tableau contenant les variables internes 21 : C pilotant les equations 22 : C VAR(1)=p ; VAR(2)=r ;VAR(3)=D 23 : C EPSTHD vitesse de dilatation thermique au debut du pas 24 : C DSPT(NSTRS,NSTRS) vitesse de deformation totale 25 : C XMAT(NCOMAT) tableau des parametres scalaires du materiau 26 : C a une temperature T donnee 27 : C XMAINF(NCOMAT) tableau des parametres scalaires du materiau 28 : C a la temperature TINF 29 : C XMASUP(NCOMAT) tableau des parametres scalaires du materiau 30 : C a la temperature TSUP 31 : C XMAT(1)=YOUNG ;XMAT(2)=XNU ;XMAT(3)=n 32 : C XMAT(4)=m ;XMAT(5)=KK; XMAT(6)=ALPHA 33 : C XMAT(7)=BETA ;XMAT(8)=r; XMAT(9)=A ; 34 : C XMAT(10)=EVOL ;XMAT(11)=ALPHAT 35 : C XMAT(12)=RHO; XMAT(13)=SIGY 36 : C FKX(NKX) tableau de la fonction k(X,T) contenant les courbes 37 : C de k a differentes temperatures T1,T2,T3,... 38 : C NPTEUR(NC) tableau de pointeurs sur les differentes courbes 39 : C de la fonction k 40 : C MFR indice de la formulation mecanique(seulement massif 41 : C ou coque pour les materiaux endommageables 42 : C ICARA nombre de caracteristiques geometriques des elements 43 : C finis 44 : C XCAR(ICARA) tableau des caracteristiques geometriques des 45 : C elements finis 46 : C IFOURB= -2 EN CONTR. PLANES 47 : C -1 EN DEFORM. PLANES 48 : C 0 EN AXISYMETRIE 49 : C 1 EN SERIE DE FOURIER 50 : C 2 EN TRIDIM 51 : C INDIC=0, 1 OU -1 pour plasticite avec endommagement 52 : C =2 OU -2 pour viscoplasticite avec endommagement 53 : C ITEST = 0 pas uniformite des listes de temperatures pour tous les 54 : C coefficients non lineaires 55 : C d'ou interpolation sur les coefficients du materiau 56 : C = 1 uniformite des listes de temperatures pour tous les 57 : C coefficients non lineaires 58 : C d'ou moyenne ponderee sur la variable elle-meme 59 : C ex: D(T)=A(T)*K**B(T) 60 : C T=TETA*TINF+(1-TETA)*TSUP 61 : C si ITEST=0 on remplace A(T) par (TETA*A(TINF)+(1-TETA))*A(TSUP) 62 : C et B(T) par (TETA*B(TINF)+(1-TETA))*B(TSUP) 63 : C si ITEST=1 D(T)=TETA*D(TINF)+(1-TETA)*D(TSUP) 64 : C ITHHER = 0 pas de chargement thermique et materiau constant 65 : C = 1 chargement thermique et materiau constant 66 : C = 2 chargement thermique et materiau(T) 67 : C------------------------------------------------------------------------ 68 : C 69 : C------------------------------------------------------------------------ 70 : C Sortie: EPSVD(NSTRS) derivee du tenseur des deformations 71 : C VARD(NVARI) tableau contenant les derivees des variables 72 : C internes 73 : C SIGD(NSTRS) derivee des contraintes 74 : C DD(NSTRS,NSTRS) matrice de Hooke au debut du pas 75 : C DDV(NSTRS,NSTRS) derivee de DD 76 : C DDINV(NSTRS,NSTRS) inverse de DD 77 : C------------------------------------------------------------------------ 78 : IMPLICIT INTEGER(I-N) 79 : IMPLICIT REAL*8 (A-H,O-Z) 80 : DIMENSION XMAINF(*),XMASUP(*),XCAR(*) 81 : DIMENSION SIG(*),EPSV(*),VAR(*) 82 : DIMENSION SIGD(*),EPSVD(*),VARD(*),DDINV(NSTRS,*) 83 : DIMENSION FKX(*),NPTEUR(*),XMAT(*),DSPT(*),YOUNG(*),XNU(*) 84 : DIMENSION DD(NSTRS,*),DDV(NSTRS,*),EPSTHD(*),TRUC(*) 85 : DIMENSION VARD1(3),EPSVD1(6),SIGD1(6),VARD2(3),EPSVD2(6) 86 : C 87 : C----- le materiau est constant ou pas, on derive normalement les contraintes 88 : C 89 : IFLAG=0 90 : IF ( (ITEST.EQ.1).AND.(ITHHER.EQ.2) ) THEN 91 : C----- si le materiau depend de la temperature et si les listes sont identiques 92 : IF (TINF.NE.TSUP) THEN 93 : C-------------- Moyenne ponderee sur les vitesses des variables 94 : IFLAG=1 95 : TETA=(TI-TSUP)/(TINF-TSUP) 95 : CALL DERIV(TAU,SIG,EPSV,VAR,SIGD1,EPSVD1,VARD1,EPSTHD, 96 : & DSPT,XMAINF,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,NC, 97 : & DD,DDV,DDINV,YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA, 98 : & IFOURB,INDIC,TINF,TPOINT,ITHHER,TRUC,NCOURB) 99 : DO 10 I=1,NVARI 100 : 10 VARD2(I)=TETA*VARD1(I) 101 : DO 20 I=1,NSTRS 102 : 20 EPSVD2(I)=TETA*EPSVD1(I) 102 : CALL DERIV(TAU,SIG,EPSV,VAR,SIGD1,EPSVD1,VARD1,EPSTHD, 103 : & DSPT,XMASUP,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,NC, 104 : & DD,DDV,DDINV,YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA, 105 : & IFOURB,INDIC,TSUP,TPOINT,ITHHER,TRUC,NCOURB) 106 : DO 30 I=1,NVARI 107 : 30 VARD2(I)=VARD2(I)+(1.D0-TETA)*VARD1(I) 108 : DO 40 I=1,NSTRS 109 : 40 EPSVD2(I)=EPSVD2(I)+(1.D0-TETA)*EPSVD1(I) 110 : ENDIF 111 : ENDIF 112 : C 112 : CALL DERIV(TAU,SIG,EPSV,VAR,SIGD,EPSVD,VARD,EPSTHD, 113 : &DSPT,XMAT,FKX,NPTEUR,NSTRS,NVARI,NCOMAT,NKX,NC,DD,DDV,DDINV, 114 : &YOUNG,NYOUNG,XNU,NXNU,MFR,XCAR,ICARA,IFOURB,INDIC, 115 : &TI,TPOINT,ITHHER,TRUC,NCOURB) 116 : C 117 : IF (IFLAG.EQ.0) GOTO 100 118 : C 119 : DO 50 I=1,NVARI 120 : 50 VARD(I)=VARD2(I) 121 : DO 60 I=1,NSTRS 122 : 60 EPSVD(I)=EPSVD2(I) 123 : C 123 : CALL ZDANUL(SIGD,NSTRS) 124 : DEN=1.D0-VAR(3) 125 : DO 90 I=1,NSTRS 126 : DO 95 J=1,NSTRS 127 : SIGD(I)=SIGD(I)+(TPOINT*(DD(I,J)*SIG(J))) 128 : 95 CONTINUE 129 : SIGD(I)=SIGD(I)-((VARD(3)/DEN)*SIG(I)) 130 : 90 CONTINUE 130 : CALL ELAST1(1,IFOURB,VAR,NVARI,XMAT,NCOMAT,YUNGV,ENUV, 131 : &XCAR,ICARA,MFR,NSTRS,DD,DDV,KERRE,INDIC,ITHHER) 132 : DO 80 I=1,NSTRS 133 : DO 85 J=1,NSTRS 134 : SIGD(I)=SIGD(I)+ DD(I,J)*( DSPT(J)-EPSVD(J)-EPSTHD(J) ) 135 : 85 CONTINUE 136 : 80 CONTINUE 137 : C 138 : 100 CONTINUE 139 : RETURN 140 : END 141 : 142 : 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer