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