1 : C SICSIC SOURCE AM 08/12/19 21:17:06 6237 2 : SUBROUTINE SICSIC(WRK0,WRK1,WRK22,WRK5,WTRAV,CMATE,N2EL, 3 : & N2PTEL,IB,IGAU,EPAIST,NVARI,NBPGAU,MELE,NPINT, 4 : & SECT,LHOOK,CRIGI,NMATT,ISTEP,KERRE) 5 : C 6 : C 7 : C 8 : C variables en entree 9 : C 10 : C WRK0,KRK1,WRK5 pointeurs sur des segments de travail 11 : C 12 : C 13 : C WRK0: 14 : C XMAT(NMATT): tableau composantes materiaux 15 : C 16 : C WRK1: 17 : C SIG0(NSTRS) : contraintes au debut du pas 18 : C VAR0(NVARI) : variables internes au debut du pas 19 : C DEPST(NSTRS): increment de deformation totale 20 : C 21 : C WRK22: 22 : C XXE: coordonnees de l'element en double precison 23 : C 24 : C WTRAV: 25 : C TXR: cosinus directeurs des axes locaux de l'element massif 26 : C 27 : C 28 : C WRK5: 29 : C 30 : C 31 : C 32 : C NSTRS nombre de composantes dans les vecteurs des contraintes 33 : C et les vecteurs des deformations 34 : C 35 : C NVARI nombre de variables internes (doit etre egal a 3) 36 : C 37 : C NMATT nombre de constantes du materiau 38 : C 39 : C 40 : C 41 : C variables en sortie 42 : C 43 : C VARF variables internes finales dans WRK0 44 : C 45 : C SIGF contraintes finales dans WRK0 46 : C 47 : IMPLICIT INTEGER(I-N) 48 : IMPLICIT REAL*8(A-H,O-Z) 49 : -INC CCOPTIO 50 : -INC CCREEL 51 : * 52 : * Commun NECOU utilisé dans ECOINC 53 : * 54 : COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 55 : . ITYP,IFOURB,IFLUAG, 56 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 57 : . JFLUAG,KFLUAG,LFLUAG, 58 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 59 : * 60 : * 61 : * Commun IECOU: sert de fourre-tout pour les initialisations 62 : * d'entiers 63 : * 64 : COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 65 : . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND, 66 : . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT, 67 : . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA, 68 : . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA, 69 : . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME, 70 : . icou45,icou46,icou47,icou48,icou49,icou50, 71 : . icou51,icou52,icou53,icou54,icou55,icou56 72 : . icou57,icou58 73 : * 74 : SEGMENT WRK0 75 : REAL*8 XMAT(NMATT) 76 : ENDSEGMENT 77 : * 78 : SEGMENT WRK1 79 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 80 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 81 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 82 : ENDSEGMENT 83 : * 84 : SEGMENT WRK22 85 : REAL*8 XXE(3,NBNN) 86 : ENDSEGMENT 87 : * 88 : SEGMENT WRK5 89 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS) 90 : ENDSEGMENT 91 : SEGMENT WRK6 92 : REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS) 93 : END SEGMENT 94 : * 95 : SEGMENT WTRAV 96 : REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT) 97 : REAL*8 VALCAR(NUCAR),DSIGT(NSTRS) 98 : REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK) 99 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 100 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK) 101 : ENDSEGMENT 102 : * 103 : CHARACTER*8 CMATE 104 : INTEGER NSTRS,NVARI,NMATT 105 : INTEGER KCAS,IRTD,ISTRS,KERRE,MFR 106 : 107 : REAL*8 IDAUX(6,6) 108 : REAL*8 DOR1(3), DOR2(3), DOR3(3) 109 : REAL*8 MORTH (3,3), IORTH (3,3), AEQ (3,3) 110 : REAL*8 H1 (6,6), H2(6,6), H3(6,6) 111 : REAL*8 H01 (6,6), H02(6,6), H03(6,6) 112 : REAL*8 K01 (6,6), K02(6,6), K03(6,6), KW(6,6) 113 : REAL*8 KEFF1(6,6), KEFF2(6,6), KEFF3(6,6) 114 : REAL*8 RIG0 (6,6), CED0 (6,6) 115 : REAL*8 SORTH(6), SIG0V(6), SIGFV(6), 116 : & DEFI(6), DEPSTV(6), DORTH(6) 117 : REAL*8 VARTMP 118 : INTEGER HCLO1, HCLO2, HCLO3 119 : 120 : 121 : DATA H1 122 : & /1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 123 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 124 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 125 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 126 : & 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 127 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.7/ 128 : 129 : DATA H2 130 : & /0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 131 : & 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 132 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 133 : & 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 134 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 135 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.7/ 136 : * 137 : DATA H3 138 : & /0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 139 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 140 : & 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 141 : & 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 142 : & 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 143 : & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ 144 : * 145 : DATA AEQ 146 : & /1.0, 0.0, 0.0, 147 : & 0.0, 1.0, 0.0, 148 : & 0.0, 0.0, 1.0/ 149 : * 150 : * PHENOMENOLOGICAL COEFFICIENTS 151 : * 152 : * deactivation parameter (scalars) 153 : REAL*8 ETADS 154 : DATA ETADS /1/ 155 : * closure stress 156 : * REAL*8 SIGCLO (NSTRSS) 157 : *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 158 : *ON NE LE PREND PAS EN COMPTE!!!! 159 : *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 160 : 161 : 162 : 163 : 164 : * scalar damage law parameters 165 : REAL*8 G1DC, G1Y0, G1YC, G1P 166 : REAL*8 G2DC, G2Y0, G2YC, G2P 167 : REAL*8 G3DC, G3Y0, G3YC, G3P 168 : 169 : * Passes comme param. materiau 170 : * DATA G1DC, G1Y0, G1YC, G1P 171 : * & / 0.6, 130.0, 400.0, 1.0/ 172 : * DATA G2DC, G2Y0, G2YC, G2P 173 : * & / 0.6, 130.0, 400.0, 1.0/ 174 : * DATA G3DC, G3Y0, G3YC, G3P 175 : * & / 0.6, 130.0, 400.0, 1.0/ 176 : 177 : * scalar damage indicators 178 : REAL*8 DOM1, DOM2, DOM3 179 : REAL*8 YGR1, YGR2, YGR3, YW(6) 180 : REAL*8 YEQ1, YEQ2, YEQ3 181 : 182 : ***** INITIALIZATION VARIABLES 183 : 184 : 185 : 186 : * Proprietes materiau 187 : YG1 = XMAT(1) 188 : YG2 = XMAT(2) 189 : YG3 = XMAT(3) 190 : XNU12 = XMAT(4) 191 : XNU23 = XMAT(5) 192 : XNU13 = XMAT(6) 193 : G12 = XMAT(7) 194 : G23 = XMAT(8) 195 : G13 = XMAT(9) 196 : 197 : 198 : G1DC = XMAT(16) 199 : G1Y0 = XMAT(17) 200 : G1YC = XMAT(18) 201 : G1P = XMAT(19) 202 : G2DC = XMAT(20) 203 : G2Y0 = XMAT(21) 204 : G2YC = XMAT(22) 205 : G2P = XMAT(23) 206 : G3DC = XMAT(24) 207 : G3Y0 = XMAT(25) 208 : G3YC = XMAT(26) 209 : G3P = XMAT(27) 210 : 211 : 212 : 213 : H1(5,5)= XMAT(29) 214 : H3(5,5)= XMAT(29) 215 : 216 : H1(6,6)= XMAT(30) 217 : H2(6,6)= XMAT(30) 218 : 219 : H2(4,4)= XMAT(28) 220 : H3(4,4)= XMAT(28) 221 : 222 : AEQ(1,2)= XMAT(35) 223 : AEQ(2,1)= XMAT(35) 224 : 225 : AEQ(1,3)= XMAT(37) 226 : AEQ(3,1)= XMAT(37) 227 : 228 : AEQ(2,3)= XMAT(36) 229 : AEQ(3,2)= XMAT(36) 230 : 231 : 232 : * Pour debougage 233 : PARAM=0 234 : 235 : 236 : * Variables internes du modele 237 : DOM1=VAR0(2) 238 : DOM2=VAR0(3) 239 : DOM3=VAR0(4) 240 : 241 : 242 : * Mise a zero des matrices 242 : CALL ZERO (RIG0,6,6) 242 : CALL ZERO (CED0,6,6) 242 : CALL ZERO (DEFI,6,6) 243 : 244 : 245 : ****** CALCUL DE LA DEFORMATION INITIALE A PARTIR 246 : ****** DES CONTRAINTES INITIALES 247 : 248 : 249 : 250 : **********Debougage 251 : IF (PARAM.EQ.1) THEN 252 : WRITE(IOIMP,66770) IB,IGAU 253 : 66770 format(////////2x,'element ',i6,2x,'point ',i3//) 254 : 255 : WRITE (IOIMP,*) 'Increment des deformations ' 256 : WRITE (IOIMP,99999) (DEPST(ILOOP), ILOOP=1,6) 257 : 258 : WRITE (IOIMP,*) 'Contraintes au debut de l''iteration' 259 : WRITE (IOIMP,99999) (SIG0(ILOOP), ILOOP=1,6) 260 : ENDIF 261 : **********Debougage 262 : 263 : 264 : * Controle si il faut calculer la matrice de hook 265 : 266 : 267 : IF (IB.EQ.1.AND.IGAU.EQ.1) THEN 268 : GOTO 100 269 : 270 : ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN 271 : GOTO 200 272 : 273 : ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1) THEN 274 : IF (IGAU.EQ.1) THEN 275 : GOTO 100 276 : ELSE 277 : GOTO 200 278 : ENDIF 279 : 280 : ELSE 281 : GOTO 100 282 : ENDIF 283 : 284 : 285 : * Calcul de la matrice de hook pour un materiau orthotrope 286 : 100 CONTINUE 287 : * WRITE (IOIMP,*) 'Calcul de la matrice de Hook, CMATE=', CMATE 288 : 289 : IPERR=1 289 : CALL ZERO (DDAUX,LHOOK,LHOOK) 290 : 291 : 292 : 293 : 294 : XNU21=(YG2/YG1)*XNU12 295 : XNU32=(YG3/YG2)*XNU23 296 : XNU31=(YG3/YG1)*XNU13 297 : AUX=(1.D0-XNU12*XNU21-XNU23*XNU32-XNU13*XNU31 298 : & -2.D0*XNU21*XNU32*XNU13) 299 : AUX1=AUX/YG1 300 : AUX2=AUX/YG2 301 : AUX3=AUX/YG3 302 : 303 : 304 : DDAUX(1,1)=(1.D0-XNU23*XNU32)/AUX1 305 : DDAUX(1,2)=(XNU21+XNU31*XNU23)/AUX1 306 : DDAUX(2,1)=DDAUX(1,2) 307 : DDAUX(1,3)=(XNU31+XNU21*XNU32)/AUX1 308 : DDAUX(3,1)=DDAUX(1,3) 309 : DDAUX(2,2)=(1.D0-XNU13*XNU31)/AUX2 310 : DDAUX(2,3)=(XNU32+XNU12*XNU31)/AUX2 311 : DDAUX(3,2)=DDAUX(2,3) 312 : DDAUX(3,3)=(1.D0-XNU12*XNU21)/AUX3 313 : DDAUX(4,4)=G23 314 : DDAUX(5,5)=G13 315 : DDAUX(6,6)=G12 316 : 317 : * WRITE (IOIMP,*) 'Valeurs calculees:' 318 : * DO 110 ILOOP= 1,LHOOK 319 : * WRITE (IOIMP, 99999 ) (DDAUX (ILOOP,J), J=1,LHOOK) 320 : *110 CONTINUE 321 : 322 : * On recopie la matrice de hook pour l'inversee 323 : 200 DO 205 ILOOP=1,LHOOK 324 : DO 205 JLOOP=1,LHOOK 325 : IDAUX(ILOOP,JLOOP)= DDAUX(ILOOP,JLOOP) 326 : 205 CONTINUE 327 : 328 : 329 : 330 : * Inversion de la matrice de hook 331 : * WRITE (IOIMP,*) 'Inversion de la matrice de Hook' 332 : TPREC= 0.D1 333 : IPERR=0 333 : CALL INVALM(IDAUX,LHOOK,LHOOK,IPERR,TPREC) 334 : IF (IPERR.NE.0) THEN 335 : WRITE (IOIMP,*) 'ERREUR DANS L''INVERSION DE LA MATRICE DE HOOK' 336 : ENDIF 337 : 338 : * WRITE (IOIMP,*) 'Matrice de Hook inverse' 339 : * DO 210 ILOOP= 1,LHOOK 340 : * WRITE (IOIMP,99999) (IDAUX (ILOOP,J), J=1,LHOOK) 341 : *210 CONTINUE 342 : 343 : 344 : 345 : 346 : * Calcul des tenseurs d'endommagement H01, H02, H03 346 : CALL SICTEN (H1,IDAUX,H01) 346 : CALL SICTEN (H2,IDAUX,H02) 346 : CALL SICTEN (H3,IDAUX,H03) 347 : 348 : **********Debougage 349 : IF (PARAM.EQ.1) THEN 350 : WRITE (IOIMP,*) 'Matrice H01' 351 : DO 250 ILOOP= 1,LHOOK 352 : WRITE (IOIMP, 99999 ) (H01(ILOOP,J), J=1,LHOOK) 353 : 250 CONTINUE 354 : 355 : WRITE (IOIMP,*) 'Matrice H02' 356 : DO 251 ILOOP= 1,LHOOK 357 : WRITE (IOIMP, 99999 ) (H02(ILOOP,J), J=1,LHOOK) 358 : 251 CONTINUE 359 : 360 : WRITE (IOIMP,*) 'Matrice H03' 361 : DO 252 ILOOP= 1,LHOOK 362 : WRITE (IOIMP, 99999 ) (H03(ILOOP,J), J=1,LHOOK) 363 : 252 CONTINUE 364 : ENDIF 365 : 366 : * Calcul des matrices K01,K02,K03 366 : CALL MULMAT (KW,H01,DDAUX,LHOOK,LHOOK,LHOOK) 366 : CALL MULMAT (K01,DDAUX,KW,LHOOK,LHOOK,LHOOK) 367 : 367 : CALL MULMAT (KW,H02,DDAUX,LHOOK,LHOOK,LHOOK) 367 : CALL MULMAT (K02,DDAUX,KW,LHOOK,LHOOK,LHOOK) 368 : 368 : CALL MULMAT (KW,H03,DDAUX,LHOOK,LHOOK,LHOOK) 368 : CALL MULMAT (K03,DDAUX,KW,LHOOK,LHOOK,LHOOK) 369 : 370 : * WRITE (IOIMP,*) 'Matrice K01' 371 : * DO 300 ILOOP= 1,LHOOK 372 : * WRITE (IOIMP, 99999 ) (K01(ILOOP,J), J=1,LHOOK) 373 : *300 CONTINUE 374 : * 375 : * WRITE (IOIMP,*) 'Matrice K02' 376 : * DO 301 ILOOP= 1,LHOOK 377 : * WRITE (IOIMP, 99999 ) (K02(ILOOP,J), J=1,LHOOK) 378 : *301 CONTINUE 379 : * 380 : * WRITE (IOIMP,*) 'Matrice K03' 381 : * DO 302 ILOOP= 1,LHOOK 382 : * WRITE (IOIMP, 99999 ) (K03(ILOOP,J), J=1,LHOOK) 383 : *302 CONTINUE 384 : 385 : 386 : 387 : ***** Recuperation deformation initiale dans le repere orth. 388 : 389 : DEFI(1)=VAR0(5) 390 : DEFI(2)=VAR0(6) 391 : DEFI(3)=VAR0(7) 392 : DEFI(4)=VAR0(8) 393 : DEFI(5)=VAR0(9) 394 : DEFI(6)=VAR0(10) 395 : 396 : IF (PARAM.EQ.1) THEN 397 : WRITE (IOIMP,*) 'DEFORMATION RECUPEREE' 398 : WRITE (IOIMP,99999) (DEFI(ILOOP), ILOOP=1,6) 399 : ENDIF 400 : 401 : 402 : 403 : * Calcul de l'increment de deformation dans le repere orthotrope 404 : DO 451 ILOOP=1,6 405 : DEPSTV(ILOOP)=DEPST(ILOOP) 406 : 451 CONTINUE 407 : 407 : CALL SICROT (WRK0,WTRAV,1,DEPSTV,DORTH,kerre) 408 : 409 : IF (PARAM.EQ.1) THEN 410 : WRITE (IOIMP,*) 'Increment des deformations orth. ' 411 : WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6) 412 : ENDIF 413 : 414 : 415 : * Reorganisation dans SICDEF selon la valeur de iAXEP 416 : * tc iaxep nest pas initialise je le mets à 0 !!! 417 : iaxep=0 417 : CALL SICDEF (DORTH,iAXEP,kerre) 418 : * Reorganisation supplementaire pour le contraintes en cisaillement 419 : VARTMP= DORTH(4) 420 : DORTH(4)= DORTH(6) 421 : DORTH(6)= VARTMP 422 : DORTH(5)= DORTH(5) 423 : 424 : 425 : IF (PARAM.EQ.1) THEN 426 : WRITE (IOIMP,*) 'Apres SICDEF et reorg.' 427 : WRITE (IOIMP,*) 'Increment des deformations orth. reorganise' 428 : WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6) 429 : ENDIF 430 : 431 : 432 : * On calcule les deformation totales. 433 : DO 500 ILOOP=1,NSTRSS 434 : DORTH(ILOOP)=DEFI(ILOOP)+DORTH(ILOOP) 435 : * On garde le deformations totales dans le var. internes 436 : VARF(ILOOP+4)=DORTH(ILOOP) 437 : 500 CONTINUE 438 : 439 : IF (PARAM.EQ.1) THEN 440 : WRITE (IOIMP,*) 'Calcul des def. totales (rep. orth. reorg.)' 441 : WRITE (IOIMP,99999) (DORTH(ILOOP), ILOOP=1,6) 442 : ENDIF 443 : 444 : ****************** 445 : 446 : 447 : 448 : 449 : ******************************************************** 450 : ** ON A LES DEFORMATIONS TOTALES ** 451 : ** ON PEUT CALCULER LES CONTRAINTES A LA FIN DU PAS ** 452 : ******************************************************** 453 : 454 : 455 : * WRITE (IOIMP,*) 'Calcul contraintes' 456 : 457 : 458 : * Calcul des noveaux HCLO 459 : 460 : IF (DORTH(1).LT.0) THEN 461 : HCLO1=1 462 : ELSE 463 : HCLO1=0 464 : ENDIF 465 : IF (DORTH(2).LT.0) THEN 466 : HCLO2=1 467 : ELSE 468 : HCLO2=0 469 : ENDIF 470 : IF (DORTH(3).LT.0) THEN 471 : HCLO3=1 472 : ELSE 473 : HCLO3=0 474 : ENDIF 475 : 476 : IF (PARAM.EQ.1) THEN 477 : WRITE (IOIMP,*) 'HCLO' 478 : WRITE (IOIMP,*) HCLO1,HCLO2,HCLO3 479 : ENDIF 480 : 481 : 482 : * Calcul des nouvelles KEFF 483 : DO 505 ILOOP=1,LHOOK 484 : DO 505 JLOOP=1,LHOOK 485 : KEFF1(ILOOP,JLOOP)=K01(ILOOP,JLOOP) 486 : KEFF2(ILOOP,JLOOP)=K02(ILOOP,JLOOP) 487 : KEFF3(ILOOP,JLOOP)=K03(ILOOP,JLOOP) 488 : 505 CONTINUE 489 : KEFF1(1,1)=K01(1,1)*(1-ETADS*HCLO1) 490 : KEFF2(2,2)=K02(2,2)*(1-ETADS*HCLO2) 491 : KEFF3(3,3)=K03(3,3)*(1-ETADS*HCLO3) 492 : 493 : 494 : 495 : 496 : 497 : 498 : * WRITE (IOIMP,*) 'Matrice KEFF1' 499 : * DO 502 ILOOP= 1,LHOOK 500 : * WRITE (IOIMP, 99999 ) (KEFF1(ILOOP,J), J=1,LHOOK) 501 : *502 CONTINUE 502 : * 503 : * WRITE (IOIMP,*) 'Matrice KEFF2' 504 : * DO 503 ILOOP= 1,LHOOK 505 : * WRITE (IOIMP, 99999 ) (KEFF2(ILOOP,J), J=1,LHOOK) 506 : *503 CONTINUE 507 : * 508 : * WRITE (IOIMP,*) 'Matrice KEFF3' 509 : * DO 504 ILOOP= 1,LHOOK 510 : * WRITE (IOIMP, 99999 ) (KEFF3(ILOOP,J), J=1,LHOOK) 511 : *504 CONTINUE 512 : 513 : 514 : 515 : 516 : * Calcul des YGR 517 : * WRITE (IOIMP,*) 'YW1' 517 : CALL ZERO (YW,6,1) 517 : CALL MULMAT (YW,KEFF1,DORTH,6,1,6) 518 : * WRITE (IOIMP,*) (YW(ILOOP), ILOOP=1,6) 519 : YGR1=0 520 : DO 510 ILOOP=1,6 521 : YGR1=YGR1+YW(ILOOP)*DORTH(ILOOP) 522 : 510 CONTINUE 523 : YGR1=0.5D0*YGR1 524 : * WRITE (IOIMP,*) 'YGR1=',YGR1 525 : 525 : CALL ZERO (YW,6,1) 525 : CALL MULMAT (YW,KEFF2,DORTH,6,1,6) 526 : * WRITE (IOIMP,*) 'YW2' 527 : * WRITE (IOIMP,*) (YW(ILOOP), ILOOP=1,6) 528 : YGR2=0 529 : DO 520 ILOOP=1,6 530 : YGR2=YGR2+YW(ILOOP)*DORTH(ILOOP) 531 : 520 CONTINUE 532 : YGR2=0.5D0*YGR2 533 : 533 : CALL ZERO (YW,6,1) 533 : CALL MULMAT (YW,KEFF3,DORTH,6,1,6) 534 : YGR3=0 535 : DO 530 ILOOP=1,6 536 : YGR3=YGR3+YW(ILOOP)*DORTH(ILOOP) 537 : 530 CONTINUE 538 : YGR3=0.5D0*YGR3 539 : 540 : IF (PARAM.EQ.1) THEN 541 : WRITE (IOIMP,*) 'YGR1=',YGR1 542 : WRITE (IOIMP,*) 'YGR2=',YGR2 543 : WRITE (IOIMP,*) 'YGR3=',YGR3 544 : ENDIF 545 : 546 : IF (YGR1.LT.0) THEN 547 : YGR1=0 548 : ENDIF 549 : IF (YGR2.LT.0) THEN 550 : YGR2=0 551 : ENDIF 552 : IF (YGR3.LT.0) THEN 553 : YGR3=0 554 : ENDIF 555 : 556 : 557 : 558 : 559 : *Calcul des YEQ 560 : YEQ1= AEQ(1,1)*YGR1+AEQ(1,2)*YGR2+AEQ(1,3)*YGR3 561 : YEQ2= AEQ(2,1)*YGR1+AEQ(2,2)*YGR2+AEQ(2,3)*YGR3 562 : YEQ3= AEQ(3,1)*YGR1+AEQ(3,2)*YGR2+AEQ(3,3)*YGR3 563 : 564 : 565 : 566 : 567 : 568 : 569 : *Calcul des DOM 570 : 571 : DD1= ((DSQRT(YEQ1) - G1Y0)/ G1YC ) 572 : DD2= ((DSQRT(YEQ2) - G2Y0)/ G2YC ) 573 : DD3= ((DSQRT(YEQ3) - G3Y0)/ G3YC ) 574 : 575 : IF (DD1.LT.0) THEN 576 : DD1=0 577 : ENDIF 578 : IF (DD2.LT.0) THEN 579 : DD2=0 580 : ENDIF 581 : IF (DD3.LT.0) THEN 582 : DD3=0 583 : ENDIF 584 : 585 : 586 : DOM1= G1DC*(1.D0 - DEXP (-1* 587 : & ( DD1**G1P ) ) ) 588 : DOM2= G2DC*(1.D0 - DEXP (-1* 589 : & ( DD2**G2P ) ) ) 590 : DOM3= G3DC*(1.D0 - DEXP (-1* 591 : & ( DD3**G3P ) ) ) 592 : 593 : 594 : 595 : DOM1= MAX(DOM1,VAR0(2)) 596 : DOM2= MAX(DOM2,VAR0(3)) 597 : DOM3= MAX(DOM3,VAR0(4)) 598 : 599 : IF (PARAM.EQ.1) THEN 600 : WRITE (IOIMP,*) 'DOM1=',DOM1 601 : WRITE (IOIMP,*) 'DOM2=',DOM2 602 : WRITE (IOIMP,*) 'DOM3=',DOM3 603 : ENDIF 604 : 605 : *Calcul de la matrice de rigidite 606 : 607 : 608 : DO 600 ILOOP=1,LHOOK 609 : DO 600 JLOOP=1,LHOOK 610 : RIG0(ILOOP,JLOOP)=DDAUX(ILOOP,JLOOP) 611 : & -DOM1*KEFF1(ILOOP,JLOOP) 612 : & -DOM2*KEFF2(ILOOP,JLOOP) 613 : & -DOM3*KEFF3(ILOOP,JLOOP) 614 : 600 CONTINUE 615 : 616 : 617 : * WRITE (IOIMP, *) 'Matrice RIG0 finale' 618 : * DO 610 ILOOP= 1,LHOOK 619 : * WRITE (IOIMP,99999) (RIG0 (ILOOP,J), J=1,LHOOK) 620 : *610 CONTINUE 621 : 622 : 623 : * Calcul des contraintes a la fin du pas 624 : * SORTH contient les contraintes a la fin du pas 625 : * dans le repere orthotrope 625 : CALL MULMAT (SORTH,RIG0,DORTH,6,1,6) 626 : 627 : IF (PARAM.EQ.1) THEN 628 : WRITE (IOIMP,*) 'Contraintes calculees (repere orth.)' 629 : WRITE (IOIMP,99999) (SORTH(ILOOP), ILOOP=1,6) 630 : ENDIF 631 : 632 : 633 : 634 : * ATTENTION: 635 : * On reorganise les contraintes en cisaillement pour 636 : * calculer les contraintes dans le repere global 637 : SIGFV(1)=SORTH(1) 638 : SIGFV(2)=SORTH(2) 639 : SIGFV(3)=SORTH(3) 640 : 641 : SIGFV(4)=SORTH(6) 642 : SIGFV(5)=SORTH(5) 643 : SIGFV(6)=SORTH(4) 644 : 645 : 645 : CALL SICCNT (SIGFV,iAXEP,kerre) 646 : 647 : IF (PARAM.EQ.1) THEN 648 : WRITE (IOIMP,*) 'Apres SICCNT e reorg' 649 : WRITE (IOIMP,*) 'Contraintes reorganisees' 650 : WRITE (IOIMP,99999) (SIGFV(ILOOP), ILOOP=1,6) 651 : ENDIF 652 : 653 : * On appele SICROT pour trouver le contraintes dans le repere global 654 : * On utilise SORTH pour garder le resultat 655 : * (on peut pas passer SIGF a la subroutine car il est dans un segment) 655 : CALL SICROT (WRK0,WTRAV,0,SIGFV,SORTH,kerre) 656 : 657 : 658 : * On recopie SORTH in SIGF 659 : DO 1000 ILOOP=1,6 660 : SIGF(ILOOP)=SORTH(ILOOP) 661 : 1000 CONTINUE 662 : 663 : 664 : 665 : IF (PARAM.EQ.1) THEN 666 : WRITE (IOIMP,*) 'Contraintes calculees' 667 : WRITE (IOIMP,99999) (SIGF(ILOOP), ILOOP=1,6) 668 : ENDIF 669 : 670 : 671 : 672 : VARF(2)= DOM1 673 : VARF(3)= DOM2 674 : VARF(4)= DOM3 675 : 676 : 677 : 678 : 679 : 99999 format(2x,' ',(6(1x,3pe12.5),/)) 680 : 99998 format(2x,' ',(4(1x,3pe12.5),/)) 681 : 99997 format(2x,' ',(1x,3pe12.5),/) 682 : 99996 format(2x,' ',(3(1x,1pe12.3),/)) 683 : 684 : 685 : 686 : RETURN 687 : END 688 : 689 : 690 : 691 : 692 : 693 : 694 : 695 : 696 :
© Cast3M 2003 - All rights reserved.
Disclaimer