1 : C ETAGEL SOURCE PV 11/03/07 21:16:50 6885 2 : C ETAGEL SOURCE AM 96/12/24 21:19:32 2448 3 : C====================================================================== 4 : C ETAGE - D. COMBESCURE et P. PEGON - ELSA- 1996 5 : C====================================================================== 6 : C 7 : C MODELE GLOBAL D'ETAGE 8 : C (Sur des elements de poutre TIMO - Effort tranchant/Cisail.) 9 : C 10 : SUBROUTINE ETAGEL(XDDEP,XFOR0,XFORF,VAR0,VARF,SECZ, 11 : & XDELAP,XDELAN,XDMAXP,XDMAXN,XBETA,XALPH,XTETA, 12 : & WRK2,NCURVP,NCURVN,KERRE) 13 : IMPLICIT INTEGER(I-N) 14 : IMPLICIT REAL*8(A-H,O-Z) 15 : C 16 : C======================================================================= 17 : C CETTE ROUTINE EST APPELE DANS ECO100 18 : C 19 : C 20 : C XDDEP = Incrément de déplacement 21 : C XFOR0 = Effort tranchant initial 22 : C XFORF = Effort tranchant final 23 : C VAR0 = Variables internes initiales 24 : C VARF = Variables internes finales 25 : C 26 : C SECZ = Rigidité élastique en cisaillement 27 : C XDELAP = Déplacement de fissuration (sens positif) 28 : C XDELAM = (sens négatif) 29 : C XDMAXP = Endommagement maximum lors de la plastification 30 : C (sens positif) 31 : C XDAMAXN = (sens négatif) 32 : C 33 : C XBETA = Coefficient BETA 34 : C XALPH = Coefficient ALPH 35 : C XTETA = Coefficient TETA 36 : C 37 : C WRK1 = Segment contraintes 38 : C WRK2 = Segment courbe 39 : C NCURVP = Longueur courbe sens positif 40 : C NCURVN = Longueur courbe sens negatif 41 : C 42 : C====================================================================== 43 : C XCAR = Caracteristique de la section 44 : C DEPST = Increment de deformation axiale 45 : C SIG0 = Contrainte initiale 46 : C VAR0 = Variables internes initiales 47 : C SIGF = Contrainte finale 48 : C VARF = Variables internes finales 49 : C DEFP = Deformation plastique 50 : C 51 : C======================================================================= 52 : C 53 : PARAMETER (XZER=0.D0,UN=1.D0,EPSILO=1.D-16) 54 : C 55 : C======================================================================= 56 : C VARIABLES ET SEGMENTS NECESSAIRES 57 : C========================================================================= 58 : -INC CCOPTIO 59 : C 60 : C Segment des contraintes 61 : C SEGMENT WRK1 62 : C REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 63 : C REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 64 : C REAL*8 DEFP(NSTRS),XCAR(ICARA) 65 : C ENDSEGMENT 66 : C Segment de la courbe 67 : SEGMENT WRK2 68 : REAL*8 TRAC(LTRAC) 69 : ENDSEGMENT 70 : C 71 : DIMENSION VAR0(*),VARF(*) 72 : C 73 : C 74 : C Lecture variables internes 75 : C 76 : XDAMP = VAR0(1) 77 : XDAMN = VAR0(2) 78 : XDEPMP = VAR0(3) 79 : XDEPMN = VAR0(4) 80 : XDEPA = VAR0(5) 81 : XDEPCP = VAR0(6) 82 : XDEPCN = VAR0(7) 83 : ICAS = nint(VAR0(8)) 84 : C 85 : C Voila les positions des points d'entree des deux courbes dans TRAC 86 : IPP = 1 87 : IPN = IPP+2*NCURVP 88 : C 89 : IF (XFOR0.GE.XZER) THEN 90 : XDAM = XDAMP 91 : XDEPM = XDEPMP 92 : XDELA = XDELAP 93 : ELSE 94 : XDAM = XDAMN 95 : XDEPM = XDEPMN 96 : XDELA = XDELAN 97 : ENDIF 98 : IF (ABS(UN-XDAM).LE.EPSILO) THEN 99 : XDEP0 = XDEPA 100 : ELSE 101 : XDEP0 = XDEPA + (XFOR0/((UN - XDAM)*SECZ)) 102 : ENDIF 103 : XDEPF = XDEP0 + XDDEP 104 : C 105 : C 106 : C 107 : C Fin de la lecture des variables et caracteristiques necessaires 108 : C 109 : C 110 : C Quelques calculs preliminaires 111 : C 112 : IF (XDDEP.GE.XZER) THEN 113 : IF (ICAS.EQ.0) ICAS = 15 114 : XDAM = XDAMP 115 : XDEPM = XDEPMP 116 : XDELA = XDELAP 117 : XDMAX = XDMAXP 118 : XDEGRAD = (UN - XTETA)*DEXP(-XALPH*XDEPCP) + XTETA 118 : CALL VALINF(XDEPMP,XDEGRAD,TRAC(IPP),NCURVP,XZER,XFMAC,KERRE) 119 : ELSE 120 : IF (ICAS.EQ.0) ICAS = 25 121 : XDAM = XDAMN 122 : XDEPM = XDEPMN 123 : XDELA = XDELAN 124 : XDMAX = XDMAXN 125 : XDEGRAD = (UN - XTETA)*DEXP(-XALPH*XDEPCN) + XTETA 126 : XDEPM0 = (-1.D0)*XDEPMN 126 : CALL VALINF(XDEPM0,XDEGRAD,TRAC(IPN),NCURVN, 127 : &XZER,XFMACN,KERRE) 128 : XFMAC = (-1.D0)*XFMACN 129 : ENDIF 130 : C 131 : IF (ABS(XDEPM).LE.EPSILO) THEN 132 : XFELC = XDEGRAD*SECZ*XDELA 133 : IF (ABS(UN - XDMAX).LE.EPSILO) THEN 134 : XPEN = XZER 135 : XFMAX = XFELC 136 : ELSE 137 : XPEN = (UN - (XFMAC/XFELC))/ 138 : &(UN - ((UN/(UN - XDMAX))*(XFMAC/XFELC))) 139 : XFMAX = XFELC*( UN - XPEN )/( UN - (XPEN/(UN - XDAM))) 140 : ENDIF 141 : ELSE 142 : XFMAX = XFMAC 143 : ENDIF 144 : XFPIN = XBETA*XFMAX 145 : IF (ABS(UN - XDAM).LE.EPSILO) THEN 146 : XDEPIN = XDEPM 147 : XDEPMX = XDEPM 148 : ELSE 149 : XDEPIN = XDEPM + (XFPIN/((UN - XDAM)*SECZ)) 150 : XDEPMX = XDEPM + (XFMAX/((UN - XDAM)*SECZ)) 151 : ENDIF 152 : C 153 : C================================================================== 154 : C 155 : C DRIVER 156 : C 157 : C================================================================== 158 : IF (XDDEP.GE.XZER) THEN 159 : IF (ICAS.EQ.11) THEN 160 : GOTO 1100 161 : ELSEIF (ICAS.EQ.12) THEN 162 : GOTO 1200 163 : ELSEIF (ICAS.EQ.13) THEN 164 : GOTO 1300 165 : ELSEIF (ICAS.EQ.14) THEN 166 : GOTO 1400 167 : ELSEIF (ICAS.EQ.15) THEN 168 : GOTO 1500 169 : ELSEIF (XFOR0.GE.XZER) THEN 170 : IF (XDEP0.GE.XDEPIN) THEN 171 : GOTO 1400 172 : ELSE 173 : GOTO 1300 174 : ENDIF 175 : ELSEIF (XFOR0.LT.XZER) THEN 176 : GOTO 1100 177 : ENDIF 178 : ELSE 179 : IF (ICAS.EQ.21) THEN 180 : GOTO 2100 181 : ELSEIF (ICAS.EQ.22) THEN 182 : GOTO 2200 183 : ELSEIF (ICAS.EQ.23) THEN 184 : GOTO 2300 185 : ELSEIF (ICAS.EQ.24) THEN 186 : GOTO 2400 187 : ELSEIF (ICAS.EQ.25) THEN 188 : GOTO 2500 189 : ELSEIF (XFOR0.LE.XZER) THEN 190 : IF (XDEP0.LE.XDEPIN) THEN 191 : GOTO 2400 192 : ELSE 193 : GOTO 2300 194 : ENDIF 195 : ELSEIF (XFOR0.GT.XZER) THEN 196 : GOTO 2100 197 : ENDIF 198 : ENDIF 199 : XFORF = 1.D20 200 : GOTO 9999 201 : C========================================================== 202 : C CAS A-1 - Courbe de decharge -ICAS=11 203 : C========================================================== 204 : 1100 CONTINUE 205 : XDLIM = XDEPA 206 : C 207 : IF (XDEPF.LE.XDLIM) THEN 208 : XDERES = XZER 209 : XDELOC = XDDEP 210 : ELSE 211 : XDELOC = XDLIM - XDEP0 212 : XDERES = XDDEP - XDELOC 213 : ENDIF 214 : C 215 : XKKK = (UN - XDAMN)*SECZ 216 : XFORF = XFOR0 + (XKKK*XDELOC) 217 : C 218 : IF (XDERES.EQ.XZER) THEN 219 : ICAS = 11 220 : GOTO 9999 221 : ELSE 222 : XFOR0 = XFORF 223 : XDEP0 = XDLIM 224 : XDDEP = XDERES 225 : GOTO 1300 226 : C+DC 227 : ENDIF 228 : C 229 : C========================================================== 230 : C CAS A-2 - Courbe de recharge avec pincement -ICAS=12 231 : C========================================================== 232 : 1200 CONTINUE 233 : XDLIM = XDEPIN 234 : C 235 : IF (XDEPF.LE.XDLIM) THEN 236 : XDERES = XZER 237 : XDELOC = XDDEP 238 : ELSE 239 : XDELOC = XDLIM - XDEP0 240 : XDERES = XDDEP - XDELOC 241 : ENDIF 242 : C 243 : IF (ABS(XDEPIN-XDEPMN).LE.EPSILO) THEN 244 : XKKK = XZER 245 : ELSE 246 : XKKK = (XFPIN/(XDEPIN - XDEPMN)) 247 : ENDIF 248 : C 249 : XFORF = XFOR0 + (XKKK*XDELOC) 250 : XDEPA0 = XDEPA 251 : IF (ABS(UN - XDAMP).LE.EPSILO) THEN 252 : XDEPA = XDEP0 + XDELOC 253 : ELSE 254 : XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAMP)*SECZ)) 255 : ENDIF 256 : XDEPCN = XDEPCN + XDEPA - XDEPA0 257 : IF (XDERES.EQ.XZER) THEN 258 : ICAS = 12 259 : GOTO 9999 260 : ELSE 261 : XFOR0 = XFORF 262 : XDEP0 = XDLIM 263 : XDDEP = XDERES 264 : GOTO 1400 265 : ENDIF 266 : C========================================================== 267 : C CAS A-2b- Courbe de recharge avant A-2 -ICAS=13 268 : C========================================================== 269 : 1300 CONTINUE 270 : IF (ABS(XDEPMP-XDEPMN).GT.EPSILO) THEN 271 : IF (ABS(UN - XDAMP).LE.EPSILO) THEN 272 : XDLIM = XDEPA 273 : ELSE 274 : XDLIM = XDEPA + ((XFPIN/((UN - XDAMP)*SECZ)) 275 : &/(XDEPMP - XDEPMN))*(XDEPA - XDEPMN) 276 : ENDIF 277 : ELSE 278 : XDLIM = XDEPA 279 : ENDIF 280 : C 281 : IF (XDEPF.LE.XDLIM) THEN 282 : XDERES = XZER 283 : XDELOC = XDDEP 284 : ELSE 285 : XDELOC = XDLIM - XDEP0 286 : XDERES = XDDEP - XDELOC 287 : ENDIF 288 : C 289 : XKKK = (UN - XDAMP)*SECZ 290 : XFORF = XFOR0 + (XKKK*XDELOC) 291 : C 292 : IF (XDERES.EQ.XZER) THEN 293 : ICAS = 13 294 : GOTO 9999 295 : ELSE 296 : XFOR0 = XFORF 297 : XDEP0 = XDLIM 298 : XDDEP = XDERES 299 : GOTO 1200 300 : ENDIF 301 : C========================================================== 302 : C CAS A-3 - Courbe de recharge -ICAS=14 303 : C========================================================== 304 : 1400 CONTINUE 305 : XDLIM = XDEPMX 306 : C 307 : IF (XDEPF.LE.XDLIM) THEN 308 : XDERES = XZER 309 : XDELOC = XDDEP 310 : ELSE 311 : XDELOC = XDLIM - XDEP0 312 : XDERES = XDDEP - XDELOC 313 : ENDIF 314 : C 315 : XKKK = (UN - XDAMP)*SECZ 316 : XFORF = XFOR0 + (XKKK*XDELOC) 317 : C 318 : IF (XDERES.EQ.XZER) THEN 319 : ICAS = 14 320 : GOTO 9999 321 : ELSE 322 : XFOR0 = XFORF 323 : XDEP0 = XDLIM 324 : XDDEP = XDERES 325 : GOTO 1500 326 : ENDIF 327 : C========================================================== 328 : C CAS A-4 - Courbe de simple charge -ICAS=15 329 : C========================================================== 330 : 1500 CONTINUE 330 : CALL VALINF(XZER,XDEGRAD,TRAC(IPP),NCURVP,XZER,XFMAC,KERRE) 331 : IF (ABS(UN - XDMAXP).LE.EPSILO) THEN 332 : C XDMAC = UN 333 : XDEPMA = XZER 334 : ELSE 335 : C XDMAC = XFMAC/((UN - XDMAXP)*SECZ) 336 : XDEPMA = XFMAC/((UN - XDMAXP)*SECZ) 337 : ENDIF 338 : XFELC = XDEGRAD*SECZ*XDELA 339 : XDEPEL = XFELC/SECZ 340 : IF (XDEPF.LE.XDEPMA) THEN 341 : IF (XDEPF.LE.XDEPEL) THEN 342 : XFORF = SECZ*XDEPF 343 : XDAMP = XZER 344 : ELSE 345 : IF (ABS(XDEPMA - XDEPEL).LE.EPSILO) THEN 346 : XFORF = XFELC 347 : ELSE 348 : XFORF= XFELC + ((XFMAC - XFELC) 349 : &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL) 350 : ENDIF 351 : IF (ABS(XDEPF).LE.EPSILO) THEN 352 : XDAMP = UN 353 : ELSE 354 : XDAMP = UN - (XFORF/(XDEPF*SECZ)) 355 : ENDIF 356 : ENDIF 357 : ELSE 358 : SECZF = (UN - XDMAXP)*SECZ 358 : CALL VALINF(XDEPF,XDEGRAD,TRAC(IPP),NCURVP,SECZF,XFORF,KERRE) 359 : XDAMP = XDMAX 360 : XDEPA0 = XDEPA 361 : XDEPA = XDEPF - (XFORF/SECZF) 362 : XDEPCN = XDEPCN + XDEPA - XDEPA0 363 : XDEPMP = XDEPA 364 : ENDIF 365 : ICAS = 15 366 : GOTO 9999 367 : C========================================================== 368 : C CAS B-1 - Courbe de decharge -ICAS=21 369 : C========================================================== 370 : 2100 CONTINUE 371 : XDLIM = XDEPA 372 : C 373 : IF (XDEPF.GE.XDLIM) THEN 374 : XDERES = XZER 375 : XDELOC = XDDEP 376 : ELSE 377 : XDELOC = XDLIM - XDEP0 378 : XDERES = XDDEP - XDELOC 379 : ENDIF 380 : C 381 : XKKK = (UN - XDAMP)*SECZ 382 : XFORF = XFOR0 + (XKKK*XDELOC) 383 : C 384 : IF (XDERES.EQ.XZER) THEN 385 : ICAS = 21 386 : GOTO 9999 387 : ELSE 388 : XFOR0 = XFORF 389 : XDEP0 = XDLIM 390 : XDDEP = XDERES 391 : GOTO 2300 392 : C+DC 393 : ENDIF 394 : C========================================================== 395 : C CAS B-2 - Courbe de recharge avec pincement -ICAS=22 396 : C========================================================== 397 : 2200 CONTINUE 398 : XDLIM = XDEPIN 399 : C 400 : IF (XDEPF.GE.XDLIM) THEN 401 : XDERES = XZER 402 : XDELOC = XDDEP 403 : ELSE 404 : XDELOC = XDLIM - XDEP0 405 : XDERES = XDDEP - XDELOC 406 : ENDIF 407 : C 408 : IF (ABS(XDEPIN-XDEPMP).LE.EPSILO) THEN 409 : XKKK = XZER 410 : ELSE 411 : XKKK = (XFPIN/(XDEPIN - XDEPMP)) 412 : ENDIF 413 : C 414 : XFORF = XFOR0 + (XKKK*XDELOC) 415 : XDEPA0 = XDEPA 416 : IF (ABS(UN - XDAMN).LE.EPSILO) THEN 417 : XDEPA = XDEP0 + XDELOC 418 : ELSE 419 : XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAMN)*SECZ)) 420 : ENDIF 421 : XDEPCP = XDEPCP - (XDEPA - XDEPA0) 422 : IF (XDERES.EQ.XZER) THEN 423 : ICAS = 22 424 : GOTO 9999 425 : ELSE 426 : XFOR0 = XFORF 427 : XDEP0 = XDLIM 428 : XDDEP = XDERES 429 : GOTO 2400 430 : ENDIF 431 : C========================================================== 432 : C CAS B-2b- Courbe de recharge avant A-2 -ICAS=23 433 : C========================================================== 434 : 2300 CONTINUE 435 : IF (ABS(XDEPMP-XDEPMN).GT.EPSILO) THEN 436 : IF (ABS(UN - XDAMN).LE.EPSILO) THEN 437 : XDLIM = XDEPA 438 : ELSE 439 : XDLIM = XDEPA + ((XFPIN/((UN - XDAMN)*SECZ)) 440 : &/(XDEPMN - XDEPMP))*(XDEPA - XDEPMP) 441 : ENDIF 442 : ELSE 443 : XDLIM = XDEPA 444 : ENDIF 445 : C 446 : IF (XDEPF.GE.XDLIM) THEN 447 : XDERES = XZER 448 : XDELOC = XDDEP 449 : ELSE 450 : XDELOC = XDLIM - XDEP0 451 : XDERES = XDDEP - XDELOC 452 : ENDIF 453 : C 454 : XKKK = (UN - XDAMN)*SECZ 455 : XFORF = XFOR0 + (XKKK*XDELOC) 456 : C 457 : IF (XDERES.EQ.XZER) THEN 458 : ICAS = 23 459 : GOTO 9999 460 : ELSE 461 : XFOR0 = XFORF 462 : XDEP0 = XDLIM 463 : XDDEP = XDERES 464 : GOTO 2200 465 : ENDIF 466 : C========================================================== 467 : C CAS B-3 - Courbe de recharge -ICAS=24 468 : C========================================================== 469 : 2400 CONTINUE 470 : XDLIM = XDEPMX 471 : C 472 : IF (XDEPF.GE.XDLIM) THEN 473 : XDERES = XZER 474 : XDELOC = XDDEP 475 : ELSE 476 : XDELOC = XDLIM - XDEP0 477 : XDERES = XDDEP - XDELOC 478 : ENDIF 479 : C 480 : XKKK = (UN - XDAMN)*SECZ 481 : XFORF = XFOR0 + (XKKK*XDELOC) 482 : C 483 : IF (XDERES.EQ.XZER) THEN 484 : ICAS = 24 485 : GOTO 9999 486 : ELSE 487 : XFOR0 = XFORF 488 : XDEP0 = XDLIM 489 : XDDEP = XDERES 490 : GOTO 2500 491 : ENDIF 492 : C========================================================== 493 : C CAS B-4 - Courbe de simple charge -ICAS=25 494 : C========================================================== 495 : 2500 CONTINUE 495 : CALL VALINF(XZER,XDEGRAD,TRAC(IPN),NCURVN,XZER,XFMACN,KERRE) 496 : C 497 : XFMAC = (-1.D0)*XFMACN 498 : C 499 : IF (ABS(UN - XDMAXN).LE.EPSILO) THEN 500 : C XDMAC = UN 501 : XDEPMA = XZER 502 : ELSE 503 : C XDMAC = XFMAC/((UN - XDMAXN)*SECZ) 504 : XDEPMA = XFMAC/((UN - XDMAXN)*SECZ) 505 : ENDIF 506 : C XFMAC = (-1.D0)*XFMACN 507 : XFELC = XDEGRAD*SECZ*XDELA 508 : XDEPEL = XFELC/SECZ 509 : IF (XDEPF.GE.XDEPMA) THEN 510 : IF (XDEPF.GE.XDEPEL) THEN 511 : XFORF = SECZ*XDEPF 512 : XDAMN = XZER 513 : ELSE 514 : IF (ABS(XDEPMA - XDEPEL).LE.EPSILO) THEN 515 : XFORF = XFELC 516 : ELSE 517 : XFORF= XFELC + ((XFMAC - XFELC) 518 : &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL) 519 : ENDIF 520 : IF (ABS(XDEPF).LE.EPSILO) THEN 521 : XDAMN = UN 522 : ELSE 523 : XDAMN = UN - (XFORF/(XDEPF*SECZ)) 524 : ENDIF 525 : ENDIF 526 : ELSE 527 : SECZF = (UN - XDMAXN)*SECZ 528 : XDEPFN = (-1.D0)*XDEPF 528 : CALL VALINF(XDEPFN,XDEGRAD,TRAC(IPN),NCURVN,SECZF 529 : &,XFORFN,KERRE) 530 : XFORF = (-1.D0)*XFORFN 531 : XDAMN = XDMAX 532 : XDEPA0 = XDEPA 533 : XDEPA = XDEPF - (XFORF/SECZF) 534 : XDEPCP = XDEPCP - (XDEPA - XDEPA0) 535 : XDEPMN = XDEPA 536 : ENDIF 537 : ICAS = 25 538 : GOTO 9999 539 : C 540 : C 541 : 9999 CONTINUE 542 : C 543 : C================================================================== 544 : C 545 : C On remplit les tableaux avant de sortir 546 : C 547 : C================================================================== 548 : C 549 : VARF(1) = XDAMP 550 : VARF(2) = XDAMN 551 : VARF(3) = XDEPMP 552 : VARF(4) = XDEPMN 553 : VARF(5) = XDEPA 554 : VARF(6) = XDEPCP 555 : VARF(7) = XDEPCN 556 : VARF(8) = ICAS 557 : C===================================================== 558 : C FIN DE LA ROUTINE DU MODELE 559 : C====================================================== 560 : RETURN 561 : 562 : END 563 : 564 : 565 : 566 :
© Cast3M 2003 - All rights reserved.
Disclaimer