1 : C MAZARS SOURCE CHAT 05/01/13 01:38:20 5004 2 : SUBROUTINE MAZARS (WRK0,WRK1,WRKK2,WRK5,NSTRS,NVARI, 3 : 1 NMATT,ISTEP,ICARA,JDIM,IFOUR2) 4 : C 5 : C 6 : C variables en entree 7 : C 8 : C 9 : C WRK0 pointeur sur un segment deformation au pas precedent 10 : C 11 : C WRK1 pointeur sur un segment increment de deformation 12 : C 13 : C WRKK2 pointeur sur un segment variables internes au pas precedent 14 : C 15 : C WRK5 pointeur sur un segment de deformations inelastiques 16 : C 17 : C XMATER constantes du materiau 18 : C 19 : C NSTRS nombre de composantes dans les vecteurs des contraintes 20 : C et les vecteurs des deformations 21 : C 22 : C NVARI nombre de variables internes (doit etre egal a 2) 23 : C 24 : C NMATT nombre de constantes du materiau 25 : C 26 : C ISTEP flag utilise pour separer les etapes dans un calcul non local 27 : C ISTEP=0 -----> calcul local 28 : C ISTEP=1 -----> calcul non local etape 1 on calcule les seuils 29 : C ISTEP=2 -----> calcul non local etape 2 on continue le calcul 30 : C a partir des seuils moyennes 31 : C 32 : C Modif L.Bode - 14/10/92 33 : C Nouveaux parametres en entree 34 : C JDIM Dimension de travail 35 : C ( Coques JDIM =2 , Massifs JDIM = IDIM ) 36 : C IFOUR2 Type de formulation 37 : C ( Coques IFOUR2 = -2 => contraintes planes , 38 : C Massifs IFOUR2 = IFOUR) 39 : C 40 : C variables en sortie 41 : C 42 : C VARINF variables internes finales 43 : C 44 : C SIGMAF contraintes finales 45 : C 46 : C C. LA BORDERIE MARS 1992 47 : C declaration des variables 48 : C 49 : C 50 : IMPLICIT INTEGER(I-N) 51 : IMPLICIT REAL*8(A-H,O-Z) 52 : -INC CCOPTIO 53 : SEGMENT WRK0 54 : REAL*8 XMAT(NMATT) 55 : ENDSEGMENT 56 : * 57 : SEGMENT WRK1 58 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 59 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 60 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 61 : ENDSEGMENT 62 : SEGMENT WRKK2 63 : REAL*8 EPSILI(NSTRS),DSIGT(NSTRS) 64 : ENDSEGMENT 65 : C Modif L.Bode - 14/10/92 66 : SEGMENT WRK3 67 : REAL*8 EPSILO(NSTRS) 68 : ENDSEGMENT 69 : C Definition dynamique de EPSILO 70 : C Fin modif L.Bode 71 : SEGMENT WRK5 72 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS) 73 : ENDSEGMENT 74 : CHARACTER*8 CMATE 75 : INTEGER NSTRS,NVARI,NMATT,ISTEP 76 : REAL*8 EPS33(3,3),EPSIPP(3),EPSILT(3),VALP33(3,3) 77 : REAL*8 SIGP(3),SIGPT(3),SIGPC(3),TRSIGT,TRSIGC 78 : REAL*8 YOUN,XNU,EPSD0,ACOM,BCOM,ATRA,BTRA,BETA 79 : INTEGER ISTRS,JSTRS,KCAS,IRTD 80 : REAL*8 XZERO,UN,DEUX,XPETIT 81 : REAL*8 DINI,D,DT,DC,EPSTIL,EPSTIM,ALFAT,ALFAC,GAMMA 82 : PARAMETER (XZERO=0.D0 , UN=1.D0 , DEUX=2.D0, XPETIT=1.D-12) 83 : 84 : C 85 : C 86 : C recuperation des variables initiales dans les tableaux 87 : C 88 : C 89 : N=NSTRS 90 : CMATE = 'ISOTROPE' 91 : YOUN = XMAT(1) 92 : XNU = XMAT(2) 93 : EPSD0= XMAT(5) 94 : ACOM = XMAT(6) 95 : BCOM = XMAT(7) 96 : ATRA = XMAT(8) 97 : BTRA = XMAT(9) 98 : BETA = XMAT(10) 99 : DINI = VAR0(2) 100 : 101 : C 102 : C calcul des seuils 103 : C 104 : C 105 : C calcul de la deformation totale 106 : C 107 : SEGINI WRK3 108 : DO 100 ISTRS=1,NSTRS 109 : EPSILO(ISTRS)=EPSILI(ISTRS)+DEPST(ISTRS) 110 : 100 CONTINUE 111 : C 112 : C calcul des deformations principales 113 : C 114 : C 115 : C on reecrit les deformations sous forme matricielle 116 : C 117 : C Modif L.Bode - 14/10/92 118 : C Rajout de IFOUR2 en argument de ENDOCA 119 : * print*,'on appelle ENDOCB' 119 : CALL ENDOCB (EPSILO,EPS33,2,IFOUR2) 120 : * print*,'apres endocb' 121 : C Fin modif L.Bode 122 : C 123 : C et on diagonalise 124 : C 125 : C Modif L.Bode - 14/10/92 126 : C Pour les elts Coques, on travaille en contraintes planes => JDIM =2 127 : C Pour les elts Massifs JDIM =IDIM 128 : * print*,'avant JACOB3' 128 : CALL JACOB3 (EPS33,JDIM,EPSIPP,VALP33) 129 : * print*,'apres JACOB3' 130 : C Fin modif L.Bode 131 : IF (ISTEP .EQ. 0 .OR. ISTEP.EQ.2) THEN 132 : C 133 : C on calcule la matrice de hooke et les contraintes ppales 134 : C 135 : CMATE = 'ISOTROPE' 136 : KCAS=1 137 : C Modif L.Bode - 14/10/92 138 : C IFOUR --> IFOUR2 dans appel DOHMAS 139 : * print*,'avant dohmas' 139 : CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRS,KCAS,DDHOOK,IRTD) 140 : * print*,'apres dohmas' 141 : C Fin modif L.Bode 142 : DO 200 ISTRS=1,3 143 : SIGP(ISTRS)= XZERO 144 : DO 210 JSTRS=1,3 145 : SIGP(ISTRS)=SIGP(ISTRS)+DDHOOK(ISTRS,JSTRS)*EPSIPP(JSTRS) 146 : 210 CONTINUE 147 : 200 CONTINUE 148 : END IF 149 : C 150 : C on complete la deformation dans le cas des contraintes planes 151 : C 152 : C Modif L.Bode - 14/10/92 153 : C IFOUR remplace par IFOUR2 154 : IF (IFOUR2.EQ. -2) THEN 155 : EPSIPP(3)= -(EPSIPP(1) + EPSIPP(2))*XNU / (UN-XNU) 156 : END IF 157 : C Fin modif L.Bode 158 : C 159 : C on calcule le epsilontild 160 : C 161 : EPSTIL=MAX( XZERO , EPSIPP(1) )**2 + 162 : 1 MAX( XZERO , EPSIPP(2) )**2 + 163 : 2 MAX( XZERO , EPSIPP(3) )**2 164 : EPSTIL=SQRT (EPSTIL) 165 : 166 : IF (ISTEP .EQ. 0) THEN 167 : EPSTIM=EPSTIL 168 : VARF(1)=EPSTIL 169 : ELSE IF (ISTEP .EQ. 1) THEN 170 : VARF(2)=DINI 171 : VARF(1)=EPSTIL 172 : ELSE IF (ISTEP .EQ. 2) THEN 173 : EPSTIM=VAR0(1) 174 : VARF(1)=EPSTIM 175 : ELSE 176 : PRINT*,'DANS MAZARS ISTEP = 0,1,2 ET PAS ',ISTEP 177 : END IF 178 : IF ( (ISTEP .EQ. 0) .OR. (ISTEP .EQ. 2)) THEN 179 : C 180 : C on calcule l'endommagement et les contraintes 181 : C 182 : C 183 : C on calcule ALFAT ALFAC DT et DC puis D 184 : C dans le cas ou le seuil initial est depasse 185 : C 186 : IF ( EPSTIM .GT. EPSD0) THEN 187 : C 188 : C calcul de l'endommagement 189 : C 190 : C 191 : C on calcule le signe des contraintes elastiques 192 : C 193 : DO 300 ISTRS=1,3 194 : IF (SIGP(ISTRS).LT. XZERO) THEN 195 : SIGPC(ISTRS)=SIGP(ISTRS) 196 : SIGPT(ISTRS)=XZERO 197 : ELSE 198 : SIGPT(ISTRS)=SIGP(ISTRS) 199 : SIGPC(ISTRS)=XZERO 200 : END IF 201 : 300 CONTINUE 202 : TRSIGT=SIGPT(1)+SIGPT(2)+SIGPT(3) 203 : TRSIGC=SIGPC(1)+SIGPC(2)+SIGPC(3) 204 : C 205 : C on calcule les deformations dues aux contraintes positives 206 : C 207 : DO 400 ISTRS=1,3 208 : EPSILT(ISTRS)=(SIGPT(ISTRS)*(UN+XNU)-TRSIGT*XNU)/YOUN 209 : 400 CONTINUE 210 : C 211 : C on en deduit ALFAT et ALFAC 212 : C 213 : ALFAT = MAX(XZERO,EPSIPP(1))*EPSILT(1) + 214 : 1 MAX(XZERO,EPSIPP(2))*EPSILT(2) + 215 : 2 MAX(XZERO,EPSIPP(3))*EPSILT(3) 216 : ALFAT = ALFAT/(EPSTIL*EPSTIL) 217 : ALFAC = UN - ALFAT 218 : C 219 : C modification pour la bi ou tricompression 220 : C 221 : IF (TRSIGC.LT. -XPETIT .AND. TRSIGT.LT.XPETIT) THEN 222 : GAMMA=SIGPC(1)*SIGPC(1)+SIGPC(2)*SIGPC(2)+ 223 : 1 SIGPC(3)*SIGPC(3) 224 : GAMMA=-SQRT(GAMMA)/TRSIGC 225 : EPSTIM=EPSTIM*GAMMA 226 : END IF 227 : C 228 : C amelioration de la reponse en cisaillement pour beta > 1. 229 : C 230 : IF (BETA .GT. UN) THEN 231 : IF ( ALFAT .GT. XPETIT ) THEN 232 : ALFAT=ALFAT**BETA 233 : END IF 234 : IF ( ALFAC .GT. XPETIT ) THEN 235 : ALFAC=ALFAC**BETA 236 : END IF 237 : END IF 238 : 239 : C 240 : C on calcule DT et DC puis D 241 : C dans le cas ou le seuil initial est depasse 242 : C 243 : C on est oblige de verifier car on a pu multiplier par gamma 244 : C 245 : IF (EPSTIM .GT. EPSD0) THEN 246 : DT=UN - EPSD0*(UN-ATRA)/EPSTIM - 247 : 1 ATRA*EXP(-BTRA*(EPSTIM-EPSD0)) 248 : DC=UN - EPSD0*(UN-ACOM)/EPSTIM - 249 : 1 ACOM*EXP(-BCOM*(EPSTIM-EPSD0)) 250 : ELSE 251 : DT=XZERO 252 : DC=XZERO 253 : END IF 254 : D = ALFAT*DT + ALFAC*DC 255 : C 256 : C on borne la valeur de D a 0.99999 257 : C 258 : D=MIN ( D , UN-1.D-05 ) 259 : ELSE 260 : D=XZERO 261 : END IF 262 : C 263 : C on teste la croissance de D 264 : C 265 : D=MAX ( D , DINI ) 266 : C 267 : C on le stocke dans les variables internes finales 268 : C 269 : VARF(2)= D 270 : C 271 : C on calcule les contraintes finales 272 : C 272 : CALL MATVE1 (DDHOOK,EPSILO,NSTRS,NSTRS,SIGF,2) 273 : DO 500 ISTRS=1,NSTRS 274 : SIGF(ISTRS)=SIGF(ISTRS)*(UN-D) 275 : 500 CONTINUE 276 : C 277 : C et les deformations inelastiques finales 278 : C 279 : DO 600 ISTRS=1,NSTRS 280 : EPINF(ISTRS)=EPSILO(ISTRS)*D 281 : 600 CONTINUE 282 : 283 : END IF 284 : SEGSUP WRK3 285 : RETURN 286 : END 287 : 288 : 289 :
© Cast3M 2003 - All rights reserved.
Disclaimer