etagel
C ETAGEL SOURCE CB215821 17/11/30 21:16:06 9639 C ETAGEL SOURCE AM 96/12/24 21:19:32 2448 C====================================================================== C ETAGE - D. COMBESCURE et P. PEGON - ELSA- 1996 C====================================================================== C C MODELE GLOBAL D'ETAGE C (Sur des elements de poutre TIMO - Effort tranchant/Cisail.) C & XDELAP,XDELAN,XDMAXP,XDMAXN,XBETA,XALPH,XTETA, & WRK2,NCURVP,NCURVN,KERRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C C======================================================================= C CETTE ROUTINE EST APPELE DANS ECO100 C C C XDDEP = Incrément de déplacement C XFOR0 = Effort tranchant initial C XFORF = Effort tranchant final C VAR0 = Variables internes initiales C VARF = Variables internes finales C C SECZ = Rigidité élastique en cisaillement C XDELAP = Déplacement de fissuration (sens positif) C XDELAM = (sens négatif) C XDMAXP = Endommagement maximum lors de la plastification C (sens positif) C XDAMAXN = (sens négatif) C C XBETA = Coefficient BETA C XALPH = Coefficient ALPH C XTETA = Coefficient TETA C C WRK1 = Segment contraintes C WRK2 = Segment courbe C NCURVP = Longueur courbe sens positif C NCURVN = Longueur courbe sens negatif C C====================================================================== C XCAR = Caracteristique de la section C DEPST = Increment de deformation axiale C SIG0 = Contrainte initiale C VAR0 = Variables internes initiales C SIGF = Contrainte finale C VARF = Variables internes finales C DEFP = Deformation plastique C C======================================================================= C PARAMETER (XZER=0.D0,UN=1.D0,EPSILO=1.D-16) C C======================================================================= C VARIABLES ET SEGMENTS NECESSAIRES C========================================================================= -INC PPARAM -INC CCOPTIO C C Segment des contraintes C SEGMENT WRK1 C REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) C REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) C REAL*8 DEFP(NSTRS),XCAR(ICARA) C ENDSEGMENT C Segment de la courbe SEGMENT WRK2 REAL*8 TRAC(LTRAC) ENDSEGMENT C DIMENSION VAR0(*),VARF(*) C C C Lecture variables internes C XDAMP = VAR0(1) XDAMN = VAR0(2) XDEPMP = VAR0(3) XDEPMN = VAR0(4) XDEPA = VAR0(5) XDEPCP = VAR0(6) XDEPCN = VAR0(7) ICAS = nint(VAR0(8)) C C Voila les positions des points d'entree des deux courbes dans TRAC IPP = 1 IPN = IPP+2*NCURVP C IF (XFOR0.GE.XZER) THEN XDAM = XDAMP XDEPM = XDEPMP XDELA = XDELAP ELSE XDAM = XDAMN XDEPM = XDEPMN XDELA = XDELAN ENDIF IF (ABS(UN-XDAM).LE.EPSILO) THEN XDEP0 = XDEPA ELSE XDEP0 = XDEPA + (XFOR0/((UN - XDAM)*SECZ)) ENDIF XDEPF = XDEP0 + XDDEP C C C C Fin de la lecture des variables et caracteristiques necessaires C C C Quelques calculs preliminaires C IF (XDDEP.GE.XZER) THEN IF (ICAS.EQ.0) ICAS = 15 XDAM = XDAMP XDEPM = XDEPMP XDELA = XDELAP XDMAX = XDMAXP XDEGRAD = (UN - XTETA)*EXP(-XALPH*XDEPCP) + XTETA ELSE IF (ICAS.EQ.0) ICAS = 25 XDAM = XDAMN XDEPM = XDEPMN XDELA = XDELAN XDMAX = XDMAXN XDEGRAD = (UN - XTETA)*EXP(-XALPH*XDEPCN) + XTETA XDEPM0 = (-1.D0)*XDEPMN &XZER,XFMACN,KERRE) XFMAC = (-1.D0)*XFMACN ENDIF C IF (ABS(XDEPM).LE.EPSILO) THEN XFELC = XDEGRAD*SECZ*XDELA IF (ABS(UN - XDMAX).LE.EPSILO) THEN XPEN = XZER XFMAX = XFELC ELSE XPEN = (UN - (XFMAC/XFELC))/ &(UN - ((UN/(UN - XDMAX))*(XFMAC/XFELC))) XFMAX = XFELC*( UN - XPEN )/( UN - (XPEN/(UN - XDAM))) ENDIF ELSE XFMAX = XFMAC ENDIF XFPIN = XBETA*XFMAX IF (ABS(UN - XDAM).LE.EPSILO) THEN XDEPIN = XDEPM XDEPMX = XDEPM ELSE XDEPIN = XDEPM + (XFPIN/((UN - XDAM)*SECZ)) XDEPMX = XDEPM + (XFMAX/((UN - XDAM)*SECZ)) ENDIF C C================================================================== C C DRIVER C C================================================================== IF (XDDEP.GE.XZER) THEN IF (ICAS.EQ.11) THEN GOTO 1100 ELSEIF (ICAS.EQ.12) THEN GOTO 1200 ELSEIF (ICAS.EQ.13) THEN GOTO 1300 ELSEIF (ICAS.EQ.14) THEN GOTO 1400 ELSEIF (ICAS.EQ.15) THEN GOTO 1500 ELSEIF (XFOR0.GE.XZER) THEN IF (XDEP0.GE.XDEPIN) THEN GOTO 1400 ELSE GOTO 1300 ENDIF ELSEIF (XFOR0.LT.XZER) THEN GOTO 1100 ENDIF ELSE IF (ICAS.EQ.21) THEN GOTO 2100 ELSEIF (ICAS.EQ.22) THEN GOTO 2200 ELSEIF (ICAS.EQ.23) THEN GOTO 2300 ELSEIF (ICAS.EQ.24) THEN GOTO 2400 ELSEIF (ICAS.EQ.25) THEN GOTO 2500 ELSEIF (XFOR0.LE.XZER) THEN IF (XDEP0.LE.XDEPIN) THEN GOTO 2400 ELSE GOTO 2300 ENDIF ELSEIF (XFOR0.GT.XZER) THEN GOTO 2100 ENDIF ENDIF XFORF = 1.D20 GOTO 9999 C========================================================== C CAS A-1 - Courbe de decharge -ICAS=11 C========================================================== 1100 CONTINUE XDLIM = XDEPA C IF (XDEPF.LE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C XKKK = (UN - XDAMN)*SECZ XFORF = XFOR0 + (XKKK*XDELOC) C IF (XDERES.EQ.XZER) THEN ICAS = 11 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 1300 C+DC ENDIF C C========================================================== C CAS A-2 - Courbe de recharge avec pincement -ICAS=12 C========================================================== 1200 CONTINUE XDLIM = XDEPIN C IF (XDEPF.LE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C IF (ABS(XDEPIN-XDEPMN).LE.EPSILO) THEN XKKK = XZER ELSE XKKK = (XFPIN/(XDEPIN - XDEPMN)) ENDIF C XFORF = XFOR0 + (XKKK*XDELOC) XDEPA0 = XDEPA IF (ABS(UN - XDAMP).LE.EPSILO) THEN XDEPA = XDEP0 + XDELOC ELSE XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAMP)*SECZ)) ENDIF XDEPCN = XDEPCN + XDEPA - XDEPA0 IF (XDERES.EQ.XZER) THEN ICAS = 12 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 1400 ENDIF C========================================================== C CAS A-2b- Courbe de recharge avant A-2 -ICAS=13 C========================================================== 1300 CONTINUE IF (ABS(XDEPMP-XDEPMN).GT.EPSILO) THEN IF (ABS(UN - XDAMP).LE.EPSILO) THEN XDLIM = XDEPA ELSE XDLIM = XDEPA + ((XFPIN/((UN - XDAMP)*SECZ)) &/(XDEPMP - XDEPMN))*(XDEPA - XDEPMN) ENDIF ELSE XDLIM = XDEPA ENDIF C IF (XDEPF.LE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C XKKK = (UN - XDAMP)*SECZ XFORF = XFOR0 + (XKKK*XDELOC) C IF (XDERES.EQ.XZER) THEN ICAS = 13 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 1200 ENDIF C========================================================== C CAS A-3 - Courbe de recharge -ICAS=14 C========================================================== 1400 CONTINUE XDLIM = XDEPMX C IF (XDEPF.LE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C XKKK = (UN - XDAMP)*SECZ XFORF = XFOR0 + (XKKK*XDELOC) C IF (XDERES.EQ.XZER) THEN ICAS = 14 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 1500 ENDIF C========================================================== C CAS A-4 - Courbe de simple charge -ICAS=15 C========================================================== 1500 CONTINUE IF (ABS(UN - XDMAXP).LE.EPSILO) THEN C XDMAC = UN XDEPMA = XZER ELSE C XDMAC = XFMAC/((UN - XDMAXP)*SECZ) XDEPMA = XFMAC/((UN - XDMAXP)*SECZ) ENDIF XFELC = XDEGRAD*SECZ*XDELA XDEPEL = XFELC/SECZ IF (XDEPF.LE.XDEPMA) THEN IF (XDEPF.LE.XDEPEL) THEN XFORF = SECZ*XDEPF XDAMP = XZER ELSE IF (ABS(XDEPMA - XDEPEL).LE.EPSILO) THEN XFORF = XFELC ELSE XFORF= XFELC + ((XFMAC - XFELC) &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL) ENDIF IF (ABS(XDEPF).LE.EPSILO) THEN XDAMP = UN ELSE XDAMP = UN - (XFORF/(XDEPF*SECZ)) ENDIF ENDIF ELSE SECZF = (UN - XDMAXP)*SECZ XDAMP = XDMAX XDEPA0 = XDEPA XDEPA = XDEPF - (XFORF/SECZF) XDEPCN = XDEPCN + XDEPA - XDEPA0 XDEPMP = XDEPA ENDIF ICAS = 15 GOTO 9999 C========================================================== C CAS B-1 - Courbe de decharge -ICAS=21 C========================================================== 2100 CONTINUE XDLIM = XDEPA C IF (XDEPF.GE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C XKKK = (UN - XDAMP)*SECZ XFORF = XFOR0 + (XKKK*XDELOC) C IF (XDERES.EQ.XZER) THEN ICAS = 21 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 2300 C+DC ENDIF C========================================================== C CAS B-2 - Courbe de recharge avec pincement -ICAS=22 C========================================================== 2200 CONTINUE XDLIM = XDEPIN C IF (XDEPF.GE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C IF (ABS(XDEPIN-XDEPMP).LE.EPSILO) THEN XKKK = XZER ELSE XKKK = (XFPIN/(XDEPIN - XDEPMP)) ENDIF C XFORF = XFOR0 + (XKKK*XDELOC) XDEPA0 = XDEPA IF (ABS(UN - XDAMN).LE.EPSILO) THEN XDEPA = XDEP0 + XDELOC ELSE XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAMN)*SECZ)) ENDIF XDEPCP = XDEPCP - (XDEPA - XDEPA0) IF (XDERES.EQ.XZER) THEN ICAS = 22 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 2400 ENDIF C========================================================== C CAS B-2b- Courbe de recharge avant A-2 -ICAS=23 C========================================================== 2300 CONTINUE IF (ABS(XDEPMP-XDEPMN).GT.EPSILO) THEN IF (ABS(UN - XDAMN).LE.EPSILO) THEN XDLIM = XDEPA ELSE XDLIM = XDEPA + ((XFPIN/((UN - XDAMN)*SECZ)) &/(XDEPMN - XDEPMP))*(XDEPA - XDEPMP) ENDIF ELSE XDLIM = XDEPA ENDIF C IF (XDEPF.GE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C XKKK = (UN - XDAMN)*SECZ XFORF = XFOR0 + (XKKK*XDELOC) C IF (XDERES.EQ.XZER) THEN ICAS = 23 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 2200 ENDIF C========================================================== C CAS B-3 - Courbe de recharge -ICAS=24 C========================================================== 2400 CONTINUE XDLIM = XDEPMX C IF (XDEPF.GE.XDLIM) THEN XDERES = XZER XDELOC = XDDEP ELSE XDELOC = XDLIM - XDEP0 XDERES = XDDEP - XDELOC ENDIF C XKKK = (UN - XDAMN)*SECZ XFORF = XFOR0 + (XKKK*XDELOC) C IF (XDERES.EQ.XZER) THEN ICAS = 24 GOTO 9999 ELSE XFOR0 = XFORF XDEP0 = XDLIM XDDEP = XDERES GOTO 2500 ENDIF C========================================================== C CAS B-4 - Courbe de simple charge -ICAS=25 C========================================================== 2500 CONTINUE C XFMAC = (-1.D0)*XFMACN C IF (ABS(UN - XDMAXN).LE.EPSILO) THEN C XDMAC = UN XDEPMA = XZER ELSE C XDMAC = XFMAC/((UN - XDMAXN)*SECZ) XDEPMA = XFMAC/((UN - XDMAXN)*SECZ) ENDIF C XFMAC = (-1.D0)*XFMACN XFELC = XDEGRAD*SECZ*XDELA XDEPEL = XFELC/SECZ IF (XDEPF.GE.XDEPMA) THEN IF (XDEPF.GE.XDEPEL) THEN XFORF = SECZ*XDEPF XDAMN = XZER ELSE IF (ABS(XDEPMA - XDEPEL).LE.EPSILO) THEN XFORF = XFELC ELSE XFORF= XFELC + ((XFMAC - XFELC) &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL) ENDIF IF (ABS(XDEPF).LE.EPSILO) THEN XDAMN = UN ELSE XDAMN = UN - (XFORF/(XDEPF*SECZ)) ENDIF ENDIF ELSE SECZF = (UN - XDMAXN)*SECZ XDEPFN = (-1.D0)*XDEPF &,XFORFN,KERRE) XFORF = (-1.D0)*XFORFN XDAMN = XDMAX XDEPA0 = XDEPA XDEPA = XDEPF - (XFORF/SECZF) XDEPCP = XDEPCP - (XDEPA - XDEPA0) XDEPMN = XDEPA ENDIF ICAS = 25 GOTO 9999 C C 9999 CONTINUE C C================================================================== C C On remplit les tableaux avant de sortir C C================================================================== C VARF(1) = XDAMP VARF(2) = XDAMN VARF(3) = XDEPMP VARF(4) = XDEPMN VARF(5) = XDEPA VARF(6) = XDEPCP VARF(7) = XDEPCN VARF(8) = ICAS C===================================================== C FIN DE LA ROUTINE DU MODELE C====================================================== RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales