1 : C TENSI3 SOURCE CHAT 05/01/13 03:36:04 5004 2 : SUBROUTINE TENSI3 (SIGMA,DSIGT,DEPST,YUNG,XNU,BETR, 3 : . VECX,VECY,VECZ,ANGLE,NBVECD, 4 : . XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER, 5 : . SIGFIN,DEPSP,KERRE) 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : -INC CCOPTIO 10 : C 11 : DIMENSION SIGMA(*),DSIGT(*),DEPST(*),SIGFIN(*), 12 : . CONTR(6),DCONT(6),DDEFT(6),CONFIN(6),DCONPR(6), 13 : . DSIGS(6),DCONS(6),DEPSP(*),DDEFP(6),DDEFS(6),DEFP(6), 14 : . VECX(*),VECY(*),VECZ(*),JECHA(3),JECHAN(3), 15 : . XLTR(*),EPTR(*),XLTT(*),EPTT(*),EPRS(*),RT(*),CISA(3), 16 : . OUVER(*),DEFPR(3),DEFRF(3),ET(3),JECRO(3),KOMPR(3), 17 : . ROTATS(6,6),TATORS(6,6),ROTATE(6,6),TATORE(6,6), 18 : . AAA(6,6),DDP(6,6) 19 : C 20 : C INITIALISATION 21 : C 22 : RFE=1.D-8 23 : RFS=1.D-8 24 : UNIT=0.0174532925199432957692D0 24 : CALL ZDANUL(DEFP,6) 24 : CALL ZDANUL(DEPSP,6) 24 : CALL ZDANUL(DDEFP,6) 25 : DO 9 I=1,3 26 : JECRO(I)=0 27 : KOMPR(I)=0 28 : JECHA(I)=0 29 : JECHAN(I)=0 30 : DEFRF(I)=0.D0 31 : DEFPR(I)=0.D0 32 : DEFP(I)=OUVER(I) 33 : 9 CONTINUE 34 : C 35 : IF(IIMPI.EQ.9) THEN 36 : WRITE(IOIMP,1000) 37 : WRITE(IOIMP,1001) (SIGMA(I),I=1,6) 38 : WRITE(IOIMP,1002) (DSIGT(I),I=1,6) 39 : WRITE(IOIMP,1003) (DEPST(I),I=1,6) 40 : WRITE(IOIMP,1004) (VECX(I),I=1,3) 41 : WRITE(IOIMP,1005) (VECY(I),I=1,3) 42 : WRITE(IOIMP,1006) (VECZ(I),I=1,3) 43 : WRITE(IOIMP,1007) (XLTR(I),I=1,3) 44 : WRITE(IOIMP,1008) (EPTR(I),I=1,3) 45 : WRITE(IOIMP,1009) (XLTT(I),I=1,3) 46 : WRITE(IOIMP,1010) (EPTT(I),I=1,3) 47 : WRITE(IOIMP,1011) (EPRS(I),I=1,3) 48 : WRITE(IOIMP,1012) (RT(I),I=1,3) 49 : WRITE(IOIMP,1013) (OUVER(I),I=1,3) 50 : WRITE(IOIMP,1014) YUNG,XNU,BETR,(ANGLE/UNIT),NBVECD 51 : ENDIF 52 : C 53 : C ********************************************************************** 54 : C ******************* CAS DE NB DE VECT PROPRES DONNES = 0 ************* 55 : C ********************************************************************** 56 : C 57 : IF(NBVECD.EQ.0) THEN 58 : C 58 : CALL CLCRIT (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD,KOMPR, 59 : . JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3) 60 : C 61 : IF(IIMPI.EQ.9) THEN 62 : WRITE(IOIMP,1015) KRITER 63 : WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3 64 : WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3 65 : ENDIF 66 : C 67 : IF(KRITER.NE.0) THEN 67 : CALL CLGAMA (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD, 68 : . KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA, 69 : . YUNG,KOMPR,KERRE) 70 : IF(KERRE.NE.0) RETURN 71 : C 72 : IF(IIMPI.EQ.9) THEN 73 : WRITE(IOIMP,1018) GAMA 74 : ENDIF 75 : ENDIF 76 : C 77 : IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN 78 : C 79 : C CAS DU COMPORTEMENT ELASTIQUE LINEAIRE 80 : C 81 : DO 10 I=1,6 82 : SIGFIN(I)=SIGMA(I)+DSIGT(I) 83 : DEPSP(I)=0.D0 84 : 10 CONTINUE 85 : C 86 : IF(IIMPI.EQ.9) THEN 87 : WRITE(IOIMP,1030) (SIGFIN(I),I=1,6) 88 : WRITE(IOIMP,1031) (DEPSP(I),I=1,6) 89 : ENDIF 90 : C 91 : RETURN 92 : C 93 : ELSE 94 : C 95 : DO 20 I=1,6 96 : SIGMA(I)=SIGMA(I)+(GAMA*DSIGT(I)) 97 : DSIGT(I)=(1.D0-GAMA)*DSIGT(I) 98 : DEPST(I)=(1.D0-GAMA)*DEPST(I) 99 : 20 CONTINUE 100 : C 101 : IF(IIMPI.EQ.9) THEN 102 : WRITE(IOIMP,1001) (SIGMA(I),I=1,6) 103 : WRITE(IOIMP,1002) (DSIGT(I),I=1,6) 104 : WRITE(IOIMP,1003) (DEPST(I),I=1,6) 105 : ENDIF 106 : C 107 : C POUR CALCULER VECZ 108 : C 109 : IANGLE=0 109 : CALL CLVECA (SIGMA,VECZ,ANGLE,IANGLE) 110 : C 111 : IF(IIMPI.EQ.9) THEN 112 : WRITE(IOIMP,1006) (VECZ(I),I=1,3) 113 : ENDIF 114 : C 115 : NBVECD=1 116 : ENDIF 117 : ENDIF 118 : C 119 : C ********************************************************************** 120 : C ******************* CAS DE NB DE VECT PROPRES DONNES = 1 ************* 121 : C ********************************************************************** 122 : C 123 : IF(NBVECD.EQ.1) THEN 124 : C 125 : C INITIALISATION 126 : C 127 : ITERA=0 128 : IANGLE=0 129 : ANGLE=0.D0 130 : ET(1)=YUNG 131 : ET(2)=YUNG 132 : DEFPR(1)=0.D0 133 : DEFPR(2)=0.D0 134 : JECRO(3)=0 135 : KOMPR(3)=0 136 : JECHA(3)=0 137 : JECHAN(3)=0 138 : NJECHA=0 139 : C 140 : C POUR CALCULER VECX ET VECY 141 : C 141 : CALL CLREP(VECX,VECY,VECZ,ANGLE,IANGLE) 142 : C 143 : IF(IIMPI.EQ.9) THEN 144 : WRITE(IOIMP,1004) (VECX(I),I=1,3) 145 : WRITE(IOIMP,1005) (VECY(I),I=1,3) 146 : ENDIF 147 : C 148 : C POUR SE METTRE DANS LE REPERE DE LA FISSURE 149 : C 149 : CALL ROTA3D(ROTATS,TATORS,ROTATE,TATORE,VECX,VECY,VECZ,ANGLE) 150 : C 151 : IF(IIMPI.EQ.9) THEN 152 : WRITE(IOIMP,*) 'TATORS' 153 : WRITE(IOIMP,999) ((TATORS(I,J),J=1,6),I=1,6) 154 : WRITE(IOIMP,*) 'TATORE' 155 : WRITE(IOIMP,999) ((TATORE(I,J),J=1,6),I=1,6) 156 : ENDIF 157 : C 157 : CALL MULMAT(CONTR,TATORS,SIGMA,6,1,6) 157 : CALL MULMAT(DCONT,TATORS,DSIGT,6,1,6) 157 : CALL MULMAT(DDEFT,TATORE,DEPST,6,1,6) 158 : C 159 : IF(IIMPI.EQ.9) THEN 160 : WRITE(IOIMP,1020) (CONTR(I),I=1,6) 161 : WRITE(IOIMP,1021) (DCONT(I),I=1,6) 162 : WRITE(IOIMP,1022) (DDEFT(I),I=1,6) 163 : C 164 : ENERG=DSIGT(1)*DEPST(1)+DSIGT(2)*DEPST(2)+DSIGT(3)*DEPST(3)+ 165 : . DSIGT(4)*DEPST(4)+DSIGT(5)*DEPST(5)+DSIGT(6)*DEPST(6) 166 : ENERR=DCONT(1)*DDEFT(1)+DCONT(2)*DDEFT(2)+DCONT(3)*DDEFT(3)+ 167 : . DCONT(4)*DDEFT(4)+DCONT(5)*DDEFT(5)+DCONT(6)*DDEFT(6) 168 : DELEN=ENERG-ENERR 169 : WRITE(IOIMP,*) 'ENERG =',ENERG,' ENERR =',ENERR 170 : WRITE(IOIMP,*) 'DELEN =',DELEN 171 : ENDIF 172 : C 172 : 111 CALL CLDETA(YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER, 173 : . CONTR,DDEFT,DCONPR) 174 : C 174 : 11 CALL CLMODU(YUNG,CONTR(3),DEFP(3),DCONPR(3),DDEFT(3),RT(3), 175 : . XLTR(3),XLTT(3),EPTT(3),EPTR(3),EPRS(3), 176 : . ET(3),DEFRF(3),DEFPR(3),JECRO(3),KOMPR(3),JECHA(3), 177 : . KERRE) 178 : IF(KERRE.NE.0) RETURN 179 : C 180 : IF(IIMPI.EQ.9) THEN 181 : WRITE(IOIMP,1023) (ET(I),I=1,3) 182 : WRITE(IOIMP,1024) (DEFRF(I),I=1,3) 183 : WRITE(IOIMP,1026) (DEFPR(I),I=1,3) 184 : WRITE(IOIMP,1025) (JECRO(I),I=1,3) 185 : WRITE(IOIMP,1035) (KOMPR(I),I=1,3) 186 : WRITE(IOIMP,1036) (JECHA(I),I=1,3) 187 : ENDIF 188 : C 188 : CALL CLCISA(ET,YUNG,XNU,BETR,XLTR,CISA) 189 : C 190 : IF(IIMPI.EQ.9) THEN 191 : WRITE(IOIMP,1027) (CISA(I),I=1,3) 192 : ENDIF 193 : C 194 : C CALCUL DU MODE DE DOMAGE 195 : C 196 : KRITER=0 197 : IF(ET(1).NE.YUNG) KRITER=KRITER+1 198 : IF(ET(2).NE.YUNG) KRITER=KRITER+2 199 : IF(ET(3).NE.YUNG) KRITER=KRITER+4 200 : C 201 : IF(IIMPI.EQ.9) THEN 202 : WRITE(IOIMP,1015) KRITER 203 : ENDIF 204 : C 205 : C CALCUL DES MATRICES : A ET D' 206 : C 206 : CALL CLOUVE(AAA,YUNG,XNU,ET,CISA,KRITER,KERRE) 206 : CALL CLENDO(DDP,YUNG,XNU,ET,CISA,KRITER,KERRE) 207 : IF(KERRE.NE.0) RETURN 208 : C 209 : IF(IIMPI.EQ.9) THEN 210 : WRITE(IOIMP,*) 'AAA' 211 : WRITE(IOIMP,999) ((AAA(I,J),J=1,6),I=1,6) 212 : WRITE(IOIMP,*) 'DDP' 213 : WRITE(IOIMP,999) ((DDP(I,J),J=1,6),I=1,6) 214 : ENDIF 215 : C 216 : C CALCUL DU DELTA DEFORMATION PLASTIQUE (DDEFS) 217 : C ET DU DELTA CONTRAINTE SOLUTION (DCONS) 218 : C 218 : CALL MULMAT(DDEFS,AAA,DDEFT,6,1,6) 218 : CALL MULMAT(DCONS,DDP,DDEFT,6,1,6) 219 : C 220 : IF(IIMPI.EQ.9) THEN 221 : WRITE(IOIMP,1028) (DDEFS(I),I=1,6) 222 : WRITE(IOIMP,1029) (DCONS(I),I=1,6) 223 : ENDIF 224 : C 225 : IF(NJECHA.LE.2) THEN 226 : JECHAN(3)=JECHA(3) 227 : IF(JECHA(3).EQ.1) THEN 228 : IF((ABS(DDEFS(3))).GT.RFE) THEN 229 : IF(DDEFS(3).LT.0.D0) JECHAN(3)=2 230 : ELSE 231 : IF((DCONS(3).LT.0.D0.AND.(ABS(DCONS(3))).GT.RFS). 232 : . AND.JECRO(3).NE.1) JECHAN(3)=2 233 : ENDIF 234 : ENDIF 235 : IF(JECHA(3).EQ.2) THEN 236 : IF((ABS(DDEFS(3))).GT.RFE) THEN 237 : IF(DDEFS(3).GT.0.D0) JECHAN(3)=1 238 : ELSE 239 : IF((DCONS(3).GT.0.D0.AND.(ABS(DCONS(3))).GT.RFS). 240 : . OR.JECRO(3).EQ.1) JECHAN(3)=1 241 : ENDIF 242 : ENDIF 243 : IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) 244 : IF(JECHAN(3).NE.JECHA(3)) THEN 245 : NJECHA=NJECHA+1 246 : JECHA(3)=JECHAN(3) 247 : IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) 248 : GO TO 11 249 : ENDIF 250 : ENDIF 251 : C 252 : IF(ET(3).EQ.0.D0) THEN 253 : CONTR(3)=0.D0 254 : DCONS(3)=0.D0 255 : ENDIF 256 : C 256 : CALL CLCRIT (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,KOMPR, 257 : . JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3) 258 : C 259 : IF(IIMPI.EQ.9) THEN 260 : WRITE(IOIMP,1015) KRITER 261 : WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3 262 : WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3 263 : ENDIF 264 : C 265 : IF(KRITER.NE.0) THEN 265 : CALL CLGAMA (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD, 266 : . KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA, 267 : . YUNG,KOMPR,KERRE) 268 : IF(KERRE.NE.0) RETURN 269 : C 270 : IF(IIMPI.EQ.9) THEN 271 : WRITE(IOIMP,1018) GAMA 272 : ENDIF 273 : ENDIF 274 : C 275 : IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN 276 : C 277 : C CAS DE L ECOULEMENT SELON LA DIRECTION Z SEULE 278 : C 279 : DO 30 I=1,6 280 : CONFIN(I)=CONTR(I)+DCONS(I) 281 : DEFP(I)=DEFP(I)+DDEFS(I) 282 : DDEFP(I)=DDEFP(I)+DDEFS(I) 283 : 30 CONTINUE 284 : C 285 : IF(IIMPI.EQ.9) THEN 286 : WRITE(IOIMP,1032) (CONFIN(I),I=1,6) 287 : WRITE(IOIMP,1033) (DEFP(I),I=1,6) 288 : WRITE(IOIMP,1034) (DDEFP(I),I=1,6) 289 : ENDIF 290 : C 291 : C POUR SE METTRE DANS LE REPERE GLOBAL 292 : C 292 : CALL MULMAT(SIGFIN,ROTATS,CONFIN,6,1,6) 292 : CALL MULMAT(DEPSP,ROTATE,DDEFP,6,1,6) 293 : C 294 : C MISE A JOUR DES VARIABLES INTERNES 295 : C 296 : OUVER(1)=DEFP(1) 297 : OUVER(2)=DEFP(2) 298 : OUVER(3)=DEFP(3) 299 : IF(JECRO(3).EQ.1.AND.RT(3).GT.CONFIN(3)) RT(3)=CONFIN(3) 300 : IF(RT(3).LT.0.D0) RT(3)=0.D0 301 : C 302 : IF(IIMPI.EQ.9) THEN 303 : WRITE(IOIMP,1030) (SIGFIN(I),I=1,6) 304 : WRITE(IOIMP,1031) (DEPSP(I),I=1,6) 305 : ENDIF 306 : C 307 : RETURN 308 : C 309 : ELSE 310 : C 311 : DO 40 I=1,6 312 : DCONS(I)=GAMA*DCONS(I) 313 : DDEFS(I)=GAMA*DDEFS(I) 314 : DCONT(I)=(1.D0-GAMA)*DCONT(I) 315 : DDEFT(I)=(1.D0-GAMA)*DDEFT(I) 316 : CONTR(I)=CONTR(I)+DCONS(I) 317 : DEFP(I)=DEFP(I)+DDEFS(I) 318 : DDEFP(I)=DDEFP(I)+DDEFS(I) 319 : 40 CONTINUE 320 : IF(JECRO(3).EQ.1.AND.RT(3).GT.CONTR(3)) RT(3)=CONTR(3) 321 : IF(RT(3).LT.0.D0) RT(3)=0.D0 322 : C 323 : IF(IIMPI.EQ.9) THEN 324 : WRITE(IOIMP,1012) (RT(I),I=1,3) 325 : WRITE(IOIMP,1028) (DDEFS(I),I=1,6) 326 : WRITE(IOIMP,1029) (DCONS(I),I=1,6) 327 : WRITE(IOIMP,1020) (CONTR(I),I=1,6) 328 : WRITE(IOIMP,1021) (DCONT(I),I=1,6) 329 : WRITE(IOIMP,1022) (DDEFT(I),I=1,6) 330 : WRITE(IOIMP,1033) (DEFP(I),I=1,6) 331 : WRITE(IOIMP,1034) (DDEFP(I),I=1,6) 332 : ENDIF 333 : C 334 : GO TO (1,1,1,2,1,1,1),KRITER 335 : KERRE=465 336 : RETURN 337 : C 338 : 2 IF (ITERA.LE.10) THEN 339 : ITERA=ITERA+1 340 : JECRO(3)=0 341 : KOMPR(3)=0 342 : JECHA(3)=0 343 : JECHAN(3)=0 344 : NJECHA=0 345 : GO TO 111 346 : ELSE 347 : KERRE=466 348 : RETURN 349 : ENDIF 350 : C 351 : C POUR SE METTRE DANS LE REPERE GLOBAL 352 : C 352 : 1 CALL MULMAT(SIGMA,ROTATS,CONTR,6,1,6) 352 : CALL MULMAT(DSIGT,ROTATS,DCONT,6,1,6) 352 : CALL MULMAT(DEPST,ROTATS,DDEFT,6,1,6) 352 : CALL MULMAT(DEPSP,ROTATS,DDEFP,6,1,6) 353 : C 354 : IF(IIMPI.EQ.9) THEN 355 : WRITE(IOIMP,1001) (SIGMA(I),I=1,6) 356 : WRITE(IOIMP,1002) (DSIGT(I),I=1,6) 357 : WRITE(IOIMP,1003) (DEPST(I),I=1,6) 358 : WRITE(IOIMP,1031) (DEPSP(I),I=1,6) 359 : ENDIF 360 : C 361 : C POUR CALCULER L ANGLE 362 : C 363 : IANGLE=2 363 : CALL CLVECA (CONTR,VECZ,ANGLE,IANGLE) 364 : C 365 : IF(IIMPI.EQ.9) THEN 366 : WRITE(IOIMP,1019) ANGLE/UNIT 367 : ENDIF 368 : C 369 : NBVECD=2 370 : ENDIF 371 : ENDIF 372 : C 373 : C ********************************************************************** 374 : C ******************* CAS DE NB DE VECT PROPRES DONNES = 2 ************* 375 : C ********************************************************************** 376 : C 377 : IF(NBVECD.EQ.2) THEN 378 : C 379 : C INITIALISATION 380 : C 381 : ITERB=0 382 : NJECHA=0 383 : DO 49 I=1,3 384 : JECRO(I)=0 385 : KOMPR(I)=0 386 : JECHA(I)=0 387 : JECHAN(I)=0 388 : 49 CONTINUE 389 : C 390 : C POUR SE METTRE DANS LE REPERE DE LA FISSURE 391 : C 391 : CALL ROTA3D(ROTATS,TATORS,ROTATE,TATORE,VECX,VECY,VECZ,ANGLE) 392 : C 393 : IF(IIMPI.EQ.9) THEN 394 : WRITE(IOIMP,*) 'TATORS' 395 : WRITE(IOIMP,999) ((TATORS(I,J),J=1,6),I=1,6) 396 : WRITE(IOIMP,*) 'TATORE' 397 : WRITE(IOIMP,999) ((TATORE(I,J),J=1,6),I=1,6) 398 : ENDIF 399 : C 399 : CALL MULMAT(CONTR,TATORS,SIGMA,6,1,6) 399 : CALL MULMAT(DCONT,TATORS,DSIGT,6,1,6) 399 : CALL MULMAT(DDEFT,TATORE,DEPST,6,1,6) 400 : C 401 : IF(IIMPI.EQ.9) THEN 402 : WRITE(IOIMP,1020) (CONTR(I),I=1,6) 403 : WRITE(IOIMP,1021) (DCONT(I),I=1,6) 404 : WRITE(IOIMP,1022) (DDEFT(I),I=1,6) 405 : C 406 : ENERG=DSIGT(1)*DEPST(1)+DSIGT(2)*DEPST(2)+DSIGT(3)*DEPST(3)+ 407 : . DSIGT(4)*DEPST(4)+DSIGT(5)*DEPST(5)+DSIGT(6)*DEPST(6) 408 : ENERR=DCONT(1)*DDEFT(1)+DCONT(2)*DDEFT(2)+DCONT(3)*DDEFT(3)+ 409 : . DCONT(4)*DDEFT(4)+DCONT(5)*DDEFT(5)+DCONT(6)*DDEFT(6) 410 : DELEN=ENERG-ENERR 411 : WRITE(IOIMP,*) 'ENERG =',ENERG,' ENERR =',ENERR 412 : WRITE(IOIMP,*) 'DELEN =',DELEN 413 : ENDIF 414 : C 414 : 222 CALL CLDETA(YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER, 415 : . CONTR,DDEFT,DCONPR) 416 : C 417 : 22 DO 50 I=1,3 417 : CALL CLMODU(YUNG,CONTR(I),DEFP(I),DCONPR(I),DDEFT(I),RT(I), 418 : . XLTR(I),XLTT(I),EPTT(I),EPTR(I),EPRS(I), 419 : . ET(I),DEFRF(I),DEFPR(I),JECRO(I),KOMPR(I),JECHA(I), 420 : . KERRE) 421 : IF(KERRE.NE.0) RETURN 422 : 50 CONTINUE 423 : C 424 : IF(IIMPI.EQ.9) THEN 425 : WRITE(IOIMP,1023) (ET(I),I=1,3) 426 : WRITE(IOIMP,1024) (DEFRF(I),I=1,3) 427 : WRITE(IOIMP,1026) (DEFPR(I),I=1,3) 428 : WRITE(IOIMP,1025) (JECRO(I),I=1,3) 429 : WRITE(IOIMP,1035) (KOMPR(I),I=1,3) 430 : WRITE(IOIMP,1036) (JECHA(I),I=1,3) 431 : ENDIF 432 : C 432 : CALL CLCISA(ET,YUNG,XNU,BETR,XLTR,CISA) 433 : C 434 : IF(IIMPI.EQ.9) THEN 435 : WRITE(IOIMP,1027) (CISA(I),I=1,3) 436 : ENDIF 437 : C 438 : C CALCUL DU MODE DE DOMAGE 439 : C 440 : KRITER=0 441 : IF(ET(1).NE.YUNG) KRITER=KRITER+1 442 : IF(ET(2).NE.YUNG) KRITER=KRITER+2 443 : IF(ET(3).NE.YUNG) KRITER=KRITER+4 444 : C 445 : IF(IIMPI.EQ.9) THEN 446 : WRITE(IOIMP,1015) KRITER 447 : ENDIF 448 : C 449 : C CALCUL DES MATRICES : A ET D' 450 : C 450 : CALL CLOUVE(AAA,YUNG,XNU,ET,CISA,KRITER,KERRE) 450 : CALL CLENDO(DDP,YUNG,XNU,ET,CISA,KRITER,KERRE) 451 : IF(KERRE.NE.0) RETURN 452 : C 453 : IF(IIMPI.EQ.9) THEN 454 : WRITE(IOIMP,*) 'AAA' 455 : WRITE(IOIMP,999) ((AAA(I,J),J=1,6),I=1,6) 456 : WRITE(IOIMP,*) 'DDP' 457 : WRITE(IOIMP,999) ((DDP(I,J),J=1,6),I=1,6) 458 : ENDIF 459 : C 460 : C CALCUL DU DELTA DEFORMATION PLASTIQUE (DDEFS) 461 : C ET DU DELTA CONTRAINTE SOLUTION (DCONS) 462 : C 462 : CALL MULMAT(DDEFS,AAA,DDEFT,6,1,6) 462 : CALL MULMAT(DCONS,DDP,DDEFT,6,1,6) 463 : C 464 : IF(IIMPI.EQ.9) THEN 465 : WRITE(IOIMP,1028) (DDEFS(I),I=1,6) 466 : WRITE(IOIMP,1029) (DCONS(I),I=1,6) 467 : ENDIF 468 : C 469 : IF(NJECHA.LE.8) THEN 470 : DO 51 I=1,3 471 : JECHAN(I)=JECHA(I) 472 : IF(JECHA(I).EQ.1) THEN 473 : IF((ABS(DDEFS(I))).GT.RFE) THEN 474 : IF(DDEFS(I).LT.0.D0) JECHAN(I)=2 475 : ELSE 476 : IF((DCONS(I).LT.0.D0.AND.(ABS(DCONS(I))).GT.RFS). 477 : . AND.JECRO(I).NE.1) JECHAN(I)=2 478 : ENDIF 479 : ENDIF 480 : IF(JECHA(I).EQ.2) THEN 481 : IF((ABS(DDEFS(I))).GT.RFE) THEN 482 : IF(DDEFS(I).GT.0.D0) JECHAN(I)=1 483 : ELSE 484 : IF((DCONS(I).GT.0.D0.AND.(ABS(DCONS(I))).GT.RFS). 485 : . OR.JECRO(I).EQ.1) JECHAN(I)=1 486 : ENDIF 487 : ENDIF 488 : 51 CONTINUE 489 : IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) 490 : IF(JECHAN(1).NE.JECHA(1).OR.JECHAN(2).NE.JECHA(2).OR. 491 : . JECHAN(3).NE.JECHA(3)) THEN 492 : NJECHA=NJECHA+1 493 : DO 52 I=1,3 494 : JECHA(I)=JECHAN(I) 495 : 52 CONTINUE 496 : IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) 497 : GO TO 22 498 : ENDIF 499 : ENDIF 500 : C 501 : DO 53 I=1,3 502 : IF(ET(I).EQ.0.D0) THEN 503 : CONTR(I)=0.D0 504 : DCONS(I)=0.D0 505 : ENDIF 506 : 53 CONTINUE 507 : C 507 : CALL CLCRIT (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,KOMPR, 508 : . JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3) 509 : C 510 : IF(IIMPI.EQ.9) THEN 511 : WRITE(IOIMP,1015) KRITER 512 : WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3 513 : WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3 514 : ENDIF 515 : C 516 : IF(KRITER.NE.0) THEN 516 : CALL CLGAMA (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD, 517 : . KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA, 518 : . YUNG,KOMPR,KERRE) 519 : IF(KERRE.NE.0) RETURN 520 : C 521 : IF(IIMPI.EQ.9) THEN 522 : WRITE(IOIMP,1018) GAMA 523 : ENDIF 524 : ENDIF 525 : C 526 : IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN 527 : C 528 : C CAS DE L ECOULEMENT SANS DIFFICULTE 529 : C 530 : DO 60 I=1,6 531 : CONFIN(I)=CONTR(I)+DCONS(I) 532 : DEFP(I)=DEFP(I)+DDEFS(I) 533 : DDEFP(I)=DDEFP(I)+DDEFS(I) 534 : 60 CONTINUE 535 : C 536 : IF(IIMPI.EQ.9) THEN 537 : WRITE(IOIMP,1032) (CONFIN(I),I=1,6) 538 : WRITE(IOIMP,1033) (DEFP(I),I=1,6) 539 : WRITE(IOIMP,1034) (DDEFP(I),I=1,6) 540 : ENDIF 541 : C 542 : C POUR SE METTRE DANS LE REPERE GLOBAL 543 : C 543 : CALL MULMAT(SIGFIN,ROTATS,CONFIN,6,1,6) 543 : CALL MULMAT(DEPSP,ROTATE,DDEFP,6,1,6) 544 : C 545 : IF(IIMPI.EQ.9) THEN 546 : WRITE(IOIMP,1030) (SIGFIN(I),I=1,6) 547 : WRITE(IOIMP,1031) (DEPSP(I),I=1,6) 548 : ENDIF 549 : C 550 : C MISE A JOUR DES VARIABLES INTERNES 551 : C 552 : DO 70 I=1,3 553 : OUVER(I)=DEFP(I) 554 : IF(JECRO(I).EQ.1.AND.RT(I).GT.CONFIN(I)) RT(I)=CONFIN(I) 555 : IF(RT(I).LT.0.D0) RT(I)=0.D0 556 : 70 CONTINUE 557 : RETURN 558 : C 559 : ELSE 560 : C 561 : DO 80 I=1,6 562 : DCONS(I)=GAMA*DCONS(I) 563 : DDEFS(I)=GAMA*DDEFS(I) 564 : DCONT(I)=(1.D0-GAMA)*DCONT(I) 565 : DDEFT(I)=(1.D0-GAMA)*DDEFT(I) 566 : CONTR(I)=CONTR(I)+DCONS(I) 567 : DEFP(I)=DEFP(I)+DDEFS(I) 568 : DDEFP(I)=DDEFP(I)+DDEFS(I) 569 : 80 CONTINUE 570 : C 571 : DO 90 I=1,3 572 : IF(JECRO(I).EQ.1.AND.RT(I).GT.CONTR(I)) RT(I)=CONTR(I) 573 : IF(RT(I).LT.0.D0) RT(I)=0.D0 574 : 90 CONTINUE 575 : C 576 : IF(IIMPI.EQ.9) THEN 577 : WRITE(IOIMP,1012) (RT(I),I=1,3) 578 : WRITE(IOIMP,1028) (DDEFS(I),I=1,6) 579 : WRITE(IOIMP,1029) (DCONS(I),I=1,6) 580 : WRITE(IOIMP,1020) (CONTR(I),I=1,6) 581 : WRITE(IOIMP,1021) (DCONT(I),I=1,6) 582 : WRITE(IOIMP,1022) (DDEFT(I),I=1,6) 583 : WRITE(IOIMP,1033) (DEFP(I),I=1,6) 584 : WRITE(IOIMP,1034) (DDEFP(I),I=1,6) 585 : ENDIF 586 : C 587 : IF (ITERB.LE.15) THEN 588 : ITERB=ITERB+1 589 : NJECHA=0 590 : DO 91 I=1,3 591 : JECRO(I)=0 592 : KOMPR(I)=0 593 : JECHA(I)=0 594 : JECHAN(I)=0 595 : 91 CONTINUE 596 : GO TO 222 597 : ELSE 598 : KERRE=467 599 : RETURN 600 : ENDIF 601 : ENDIF 602 : ENDIF 603 : C 604 : 999 FORMAT(6(1X,1PE12.5)) 605 : 1000 FORMAT(1X,'ETAT INITIAL AU DEBUT DE L ECOULEMENT') 606 : 1001 FORMAT(1X,'SIGMA =',6(1X,1PE12.5)) 607 : 1002 FORMAT(1X,'DSIGT =',6(1X,1PE12.5)) 608 : 1003 FORMAT(1X,'DEPST =',6(1X,1PE12.5)) 609 : 1004 FORMAT(1X,'VECX =',3(1X,1PE12.5)) 610 : 1005 FORMAT(1X,'VECY =',3(1X,1PE12.5)) 611 : 1006 FORMAT(1X,'VECZ =',3(1X,1PE12.5)) 612 : 1007 FORMAT(1X,'XLTR =',3(1X,1PE12.5)) 613 : 1008 FORMAT(1X,'EPTR =',3(1X,1PE12.5)) 614 : 1009 FORMAT(1X,'XLTT =',3(1X,1PE12.5)) 615 : 1010 FORMAT(1X,'EPTT =',3(1X,1PE12.5)) 616 : 1011 FORMAT(1X,'EPRS =',3(1X,1PE12.5)) 617 : 1012 FORMAT(1X,'RT =',3(1X,1PE12.5)) 618 : 1013 FORMAT(1X,'OUVER =',3(1X,1PE12.5)) 619 : 1014 FORMAT(1X,'YUNG = ',1PE12.5,2X,'XNU = ',1PE12.5,2X,/, 620 : . 1X,'BETR = ',1PE12.5,2X,'ANGLE = ',1PE12.5,2X, 621 : . 'NBVECD= ',I3) 622 : 1015 FORMAT(1X,'KRITER= ',I3) 623 : 1016 FORMAT(1X,'KRITC1= ',I3,2X,'KRITC2= ',I3,2X,'KRITC3= ',I3) 624 : 1017 FORMAT(1X,'KRITE1= ',I3,2X,'KRITE2= ',I3,2X,'KRITE3= ',I3) 625 : 1018 FORMAT(1X,'GAMA = ',1PE12.5) 626 : 1019 FORMAT(1X,'ANGLE = ',1PE12.5) 627 : 1020 FORMAT(1X,'CONTR =',6(1X,1PE12.5)) 628 : 1021 FORMAT(1X,'DCONT =',6(1X,1PE12.5)) 629 : 1022 FORMAT(1X,'DDEFT =',6(1X,1PE12.5)) 630 : 1023 FORMAT(1X,'ET =',3(1X,1PE12.5)) 631 : 1024 FORMAT(1X,'DEFRF =',3(1X,1PE12.5)) 632 : 1025 FORMAT(1X,'JECRO =',3(1X,I3)) 633 : 1026 FORMAT(1X,'DEFPR =',3(1X,1PE12.5)) 634 : 1027 FORMAT(1X,'CISA =',3(1X,1PE12.5)) 635 : 1028 FORMAT(1X,'DDEFS =',6(1X,1PE12.5)) 636 : 1029 FORMAT(1X,'DCONS =',6(1X,1PE12.5)) 637 : 1030 FORMAT(1X,'SIGFIN=',6(1X,1PE12.5)) 638 : 1031 FORMAT(1X,'DEPSP =',6(1X,1PE12.5)) 639 : 1032 FORMAT(1X,'CONFIN=',6(1X,1PE12.5)) 640 : 1033 FORMAT(1X,'DEFP =',6(1X,1PE12.5)) 641 : 1034 FORMAT(1X,'DDEFP =',6(1X,1PE12.5)) 642 : 1035 FORMAT(1X,'KOMPR =',3(1X,I3)) 643 : 1036 FORMAT(1X,'JECHA =',3(1X,I3)) 644 : C 645 : END 646 : 647 :
© Cast3M 2003 - All rights reserved.
Disclaimer