Sources Esope | Cast3M

cinfil
C CINFIL    SOURCE    PV        17/12/08    21:15:45     9660           
C INFILL    SOURCE    KK2000    00/07/25    21:21:27     3913
C======================================================================
C       INFILL  - D. COMBESCURE et P. PEGON - ELSA- 1996
C======================================================================
C
C       MODELE GLOBAL DE DIAGONALE POUR LES MURS DE REMPLISSAGE
C           (Sur des elements de barre uniquement)
C
      SUBROUTINE CINFIL(wrk52,wrk53,wrk54,WRK2,NCURV)
c      SUBROUTINE INFILL(WRK0,WRK1,WRK2,NCURV,KERRE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
C=======================================================================
C             CETTE ROUTINE EST APPELE DANS ECO100
C
C
C WRK0      = Segment materiaux
C WRK1      = Segment contraintes
C WRK2      = Segment courbe
C NCURV     = Longueur courbe
C
C======================================================================
C xcarb      = Section de la barre
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-10)
C
C=======================================================================
C      VARIABLES ET SEGMENTS NECESSAIRES
C=========================================================================
 
-INC PPARAM
-INC CCOPTIO
-INC DECHE
 
C  Segment de la courbe
       SEGMENT WRK2
         REAL*8 TRAC(LTRAC)
       ENDSEGMENT
C
C  Lecture materiau
C
       YOUN = XMAT(1)
       XDELA = XMAT(5)
       XDMAX = XMAT(6)
       XBETA = XMAT(7)
       XGAMM = XMAT(8)
       XGAMP = XMAT(9)
       XALPH = XMAT(10)
       XTETA = XMAT(11)
C+TEST
C       XNETA = XMAT(12)
C+TEST
       XSECT = xcarb(1)
       YOUN = YOUN*XSECT
C
C  Lecture variables internes
C
       XDAM = VAR0(1)
       XDEPM = -VAR0(2)
       XDEPA = -VAR0(3)
       XDEPI = -VAR0(4)
       XDEPC = -VAR0(5)
       ICAS = nint(VAR0(6))
C
       XDDEP = -DEPST(1)
       XFOR0 = -SIG0(1)
       XDEP0 = XDEPA + (XFOR0/((UN - XDAM)*YOUN))
       XDEPF = XDEP0 + XDDEP
C
C  Fin de la lecture des variables et caracteristiques necessaires
C
 
C  Quelques calculs preliminairesC
       XDEGRA = (UN - XTETA)*EXP(-XALPH*XDEPC) + XTETA
C+TEST
C       XDEPMB = (UN-XNETA)*XDEPM
C+TEST
        XDEPMB = XDEPM
C
       CALL VALINF(XDEPMB,XDEGRA,TRAC(1),NCURV,XZER,XFMAC,KERRE)
       IF (ABS(XDEPMB).LE.EPSILO) THEN
         XFELC = XDEGRA*YOUN*XDELA
         XPEN = (UN - (XFMAC/XFELC))/
     &(UN - ((UN/(UN - XDMAX))*(XFMAC/XFELC)))
         XFMAX = XFELC*( UN - XPEN )/( UN - (XPEN/(UN - XDAM)))
       ELSE
         XFMAX = XFMAC
       ENDIF
       XFPIN  = XBETA*XFMAX
C+TEST
       XDEPIN = XDEPMB + (XFPIN/((UN - XDAM)*YOUN))
       XDEPMX = XDEPMB + (XFMAX/((UN - XDAM)*YOUN))
C+TEST
C
C==================================================================
C
C                          DRIVER
C
C==================================================================
       IF (XDDEP.GE.XZER) THEN
          IF ((ICAS.EQ.1).OR.(ICAS.EQ.0)) THEN
            GOTO 1000
          ELSEIF (ICAS.EQ.11) THEN
            GOTO 2100
          ELSEIF (ICAS.EQ.12) THEN
            GOTO 2200
          ELSEIF (ICAS.EQ.13) THEN
            GOTO 2300
          ELSEIF (ICAS.EQ.14) THEN
            GOTO 2400
          ELSEIF (ICAS.EQ.21) THEN
            XDLIM = XDEPIN
            IF (XDEP0.GE.XDLIM) THEN
              GOTO 2400
            ELSE
              GOTO 2300
            ENDIF
          ELSEIF (ICAS.EQ.22) THEN
            IF (XDEP0.GE.XDEPI) THEN
              GOTO 2300
            ELSE
              GOTO 2100
            ENDIF
          ELSE
            KERRE = 99
            GOTO 9999
          ENDIF
       ELSE
          IF ((ICAS.EQ.0).OR.(ICAS.EQ.22).OR.(ICAS.EQ.11)) THEN
            GOTO 3200
          ELSEIF ((ICAS.EQ.21).OR.(ICAS.EQ.1).OR.(ICAS.EQ.13)
     &.OR.(ICAS.EQ.12).OR.(ICAS.EQ.14)) THEN
            GOTO 3100
          ELSE
            KERRE = 99
            GOTO 9999
          ENDIF
       ENDIF
C==========================================================
C   CAS A - Courbe de simple charge                -ICAS=1
C==========================================================
 1000 CONTINUE
       CALL VALINF(XZER,XDEGRA,TRAC(1),NCURV,XZER,XFMAC,KERRE)
       XDMAC = XFMAC/((UN - XDMAX)*YOUN)
       XFELC = XDEGRA*YOUN*XDELA
       XDEPMA = XFMAC/((UN - XDMAX)*YOUN)
       XDEPEL = XFELC/YOUN
       IF (XDEPF.LE.XDEPMA) THEN
         IF (XDEPF.LE.XDEPEL) THEN
           XFORF = YOUN*XDEPF
           XDAM = XZER
         ELSE
           XFORF= XFELC + ((XFMAC - XFELC)
     &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL)
           XDAM = UN - (XFORF/(XDEPF*YOUN))
         ENDIF
       ELSE
           YOUNF = (UN - XDMAX)*YOUN
           CALL VALINF(XDEPF,XDEGRA,TRAC(1),NCURV,YOUNF,XFORF,KERRE)
           XDAM = XDMAX
           XDEPA = XDEPF - (XFORF/YOUNF)
           XDEPI = XDEPA
           IF (XDEPM.LE.XDEPA) THEN
             XDEPM = XDEPA
           ENDIF
       ENDIF
       ICAS = 1
       GOTO 9999
C
C==========================================================
C   CAS C1 - Courbe de recharge avec glissement    -ICAS=11
C==========================================================
 2100 CONTINUE
      XDLIM = XDEPI
C
      IF (XDEPF.LE.XDLIM) THEN
         XDERES = XZER
         XDELOC = XDDEP
      ELSE
         XDELOC = XDLIM - XDEP0
         XDERES = XDDEP - XDELOC
      ENDIF
C
      XKKK = XZER
      XFORF = XFOR0 + (XKKK*XDELOC)
      XDEPA = XDEP0 + XDELOC
C
      IF (XDERES.EQ.XZER) THEN
         ICAS = 11
         GOTO 9999
      ELSE
         XFOR0 = XFORF
         XDEP0 = XDLIM
         XDDEP = XDERES
         GOTO 2200
      ENDIF
C
C==========================================================
C   CAS C2 - Courbe de recharge avec pincement     -ICAS=12
C==========================================================
 2200 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-XDEPI).LE.EPSILO) THEN
        XKKK = XZER
      ELSE
        XKKK = (XFPIN/(XDEPIN - XDEPI))
      ENDIF
      XFORF = XFOR0 + (XKKK*XDELOC)
      XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAM)*YOUN))
      IF (XDERES.EQ.XZER) THEN
         ICAS = 12
         GOTO 9999
      ELSE
         XFOR0 = XFORF
         XDEP0 = XDLIM
         XDDEP = XDERES
         GOTO 2400
      ENDIF
C
C==========================================================
C   CAS C2bis  - Courbe de recharge petit cycle    -ICAS=13
C==========================================================
 2300 CONTINUE
      IF (ABS(XDEPMB-XDEPI).GT.EPSILO) THEN
        XDLIM = XDEPA + ((XFPIN/((UN - XDAM)*YOUN))
     &/(XDEPMB - XDEPI))*(XDEPA - XDEPI)
      ELSE
        XDLIM = XDEPIN
      ENDIF
C
      IF (XDEPF.LE.XDLIM) THEN
         XDERES = XZER
         XDELOC = XDDEP
      ELSE
         XDELOC = XDLIM - XDEP0
         XDERES = XDDEP - XDELOC
      ENDIF
C
      XKKK = (UN - XDAM)*YOUN
      XFORF = XFOR0 + (XKKK*XDELOC)
C
      IF (XDERES.EQ.XZER) THEN
         ICAS = 13
         GOTO 9999
      ELSE
         XFOR0 = XFORF
         XDEP0 = XDLIM
         XDDEP = XDERES
         GOTO 2200
      ENDIF
C
C==========================================================
C   CAS C3     - Courbe de recharge                -ICAS=14
C==========================================================
 2400 CONTINUE
      XDLIM = XDEPMX
C
      IF (XDEPF.LE.XDLIM) THEN
         XDERES = XZER
         XDELOC = XDDEP
      ELSE
         XDELOC = XDLIM - XDEP0
         XDERES = XDDEP - XDELOC
      ENDIF
C
      XKKK = (UN - XDAM)*YOUN
      XFORF = XFOR0 + (XKKK*XDELOC)
C      XDEPI = XDEPA
      IF (XDERES.EQ.XZER) THEN
         ICAS = 14
         GOTO 9999
      ELSE
         XFOR0 = XFORF
         XDEP0 = XDLIM
         XDDEP = XDERES
         GOTO 1000
      ENDIF
C
C==========================================================
C   CAS B2     -Courbe de decharge avec E          -ICAS=21
C==========================================================
 3100 CONTINUE
      XDLIM = XDEPA
C
      IF (XDEPF.GT.XDLIM) THEN
         XDERES = XZER
         XDELOC = XDDEP
      ELSE
         XDELOC = XDLIM - XDEP0
         XDERES = XDDEP - XDELOC
      ENDIF
C
      XKKK = (UN - XDAM)*YOUN
      XFORF = XFOR0 + (XKKK*XDELOC)
C
      IF (XDEPM.LE.XDEPA) THEN
         XDEPM = XDEPA
      ENDIF
C
C
      IF (XDERES.EQ.XZER) THEN
         ICAS = 21
         GOTO 9999
      ELSE
         XFOR0 = XFORF
         XDEP0 = XDLIM
         XDDEP = XDERES
         GOTO 3200
      ENDIF
C==========================================================
C   CAS B1     -Courbe de decharge avec glissement -ICAS=22
C==========================================================
 3200 CONTINUE
       XFORF = XZER
       IF (XDEPI.GE.XDEPF) THEN
C         XDEPGL = XGAMM*(UN-XNETA)*XDEPM + XGAMP*XDELA
         XDEPGL = XGAMM*XDEPM + XGAMP*XDELA
C         XDEPG2 = (UN-XNETA)*XDEPM
         XDEPG2 = XDEPM
         IF (XDEPGL.GE.XDEPG2) THEN
            XDEPGL = XDEPG2
         ENDIF
         IF (XDEPGL.GE.XDEPF) THEN
            XDEPI = XDEPGL
         ELSE
            XDEPI = XDEPF
         ENDIF
       ENDIF
       XDEPC = XDEPC + ABS(XDDEP)
       XDEPA = XDEPF
       ICAS = 22
       GOTO 9999
C==================================================================
 9999 CONTINUE
C==================================================================
C
C  On remplit les tableaux avant de sortir
C
C==================================================================
       XDEPA = XDEPF - (XFORF/((UN - XDAM)*YOUN))
       SIGF(1) = -XFORF
C
       VARF(1) = XDAM
       VARF(2) = -XDEPM
       VARF(3) = -XDEPA
       VARF(4) = -XDEPI
       VARF(5) = -XDEPC
       VARF(6) = ICAS
C=====================================================
C            FIN DE LA ROUTINE DU MODELE
C======================================================
      RETURN
      END