C DYCHEC    SOURCE    CHAT      05/01/12    23:05:18     5004
      SUBROUTINE DYCHEC(XDEP,XDPLAS,XDPLAC,XJEU,IPERM,XABSCI,
     &                  XORDON,I,XFLA,NLIAB,NIP,XVIT,XAMO,iannul)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Calcul de la force de choc pour un choc elementaire            *
*     point-point- ... -plastique. On recupere en entree             *
*     la loi de comportement sous la forme d'une evolution.          *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* e   XDEP    Valeur du deplacement.                                 *
* es  XDPLAS  Valeur du deplacement plastique (du pas precedent      *
*              en entree, du pas actuel en sortie)                   *
* es  XDPLAC Valeur du deplacement plastique cumulé (du pas          *
*             precedent en entree, du pas actuel en sortie)          *
* e   XRAID   Valeur de la raideur.                                  *
* e   XJEU    Valeur de la limite de force elastique (positive)      *
* e   XABSCI  Tableau contenant les abscisses de la loi plastique    *
*             pour la liaison point-point-plastique                  *
* e   XORDON  Tableau contenant les ordonnees de la loi plastique    *
* e   I       numero de la liaison.                                  *
*             pour la liaison point-point-plastique                  *
* e   IPERM   Indice du type de liaison (permanence et ecrouissage)  *
*                                                                    *
* iperm = -2 : liaison elastique permanente                          *
* iperm = -1 : choc elastique                                        *
* iperm =  1 : choc plastique                                        *
* iperm =  2 : liaison plastique isotrope                            *
* iperm =  3 : liaison plastique cinematique                         *
*                                                                    *
* s   XFLA    Valeur de la force de choc.                            *
*                                                                    *
*                                                                    *
*     Auteur, date de creation:                                      *
*                                                                    *
*     Lenaic FICHET  09/97 point-point- ... -plastique               *
*                                                                    *
*--------------------------------------------------------------------*
*
      REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*)
      if (iannul.eq.1) then
         xfla = 0.D0
         return
      endif
        XRAID = XORDON(I,2)/XABSCI(I,2)
*
*********** CHOC PLASTIQUE ***********
c  une sorte d'ecrouissage cinematique en supposant que la
c decharge jusqu' a la contrainte 0 est toujours lineaire

      IF (IPERM.EQ.1) THEN
        XTOT = XDEP - XJEU
        XVAL = XTOT - XDPLAS

       IF (XVAL.GE.0.D0) THEN

        XFLAT = XRAID*XVAL
        xdpla2 = xval + xdplas

        CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
        XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG)))

          IF (ABS(XFLAT).GT.XFLAC) THEN
           xfla = xflac
           XDPLAS = XTOT - XFLA/XRAID
           XDPLAC = XDPLAS
          ELSE
            XFLA = XFLAT
          ENDIF
        xfla = xfla + xamo*xvit
        if (xfla.lt.0.d0) xfla = 0.d0
       else
        xfla = 0.d0
       endif
        xfla = -xfla



************** Cas ecrouissage isotrope **************
      ELSE IF (IPERM.EQ.2) THEN

        XVAL = XDEP - XDPLAS
        XFLAT = XRAID*XVAL
        xdpla2 = abs(xval) + xdplac

        CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
        XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG)))

        IF (ABS(XFLAT).GT.XFLAC) THEN
           if (xflat.gt.0) xfla = xflac
           if (xflat.le.0) xfla = -xflac
           XDPLA0 = XDPLAS
           XDPLAS = XDEP - XFLA/XRAID
           XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 )
        ELSE
            XFLA = XFLAT
        ENDIF
        xfla = xfla + xamo*xvit
        xfla = -xfla


********** Cas ecrouissage cinematique (bilineaire) **********
      ELSE IF (IPERM.EQ.3) THEN
        XRAID2 = (XORDON(I,3)-XORDON(I,2))/
     &           (XABSCI(I,3)-XABSCI(I,2))
        xraidp = xraid*xraid2 /(xraid - xraid2)
        bacstr = xraidp*xdplas
        XVAL = XDEP - XDPLAS
        XFLAT = XRAID*XVAL
        xstres = xflat - bacstr
        if (xstres.ge.0) xcrit = XORDON(I,2)
        if (xstres.lt.0) xcrit = -XORDON(I,2)
        dxfl = xstres - xcrit

        IF (abs(xstres) .LE. abs(xcrit)) THEN
          XFLA = XFLAT
        ELSE
          xdp2 = dxfl/xraid
          XFLA = xflat - dxfl + xdp2*xraid2
          XDPLA0 = XDPLAS
          XDPLAS = XDEP - XFLA/XRAID
          XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 )
        ENDIF
        xfla = xfla + xamo*xvit

        XFLA = -XFLA

********** Cas elastique permanent **********
      ELSE IF (IPERM.EQ.-2) THEN
        XVAL = abs(XDEP)
        CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
        XFLA = (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG)))
        if (xdep.lt.0d0) xfla = -xfla
        xfla = -xfla - XAMO * XVIT

********** Choc elastique **********
      ELSE IF (IPERM.EQ.-1) THEN
        IF (XDEP.GE.XJEU) THEN
        XVAL = XDEP - XJEU
        CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
        XFLA = - (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG)))
     &         - XAMO * XVIT
        IF ( XFLA.GT.0.D0) XFLA = 0.D0
        ELSE
        XFLA = 0.D0
        ENDIF


********* autre cas *******
*      ELSE IF (IPERM.EQ.  ) THEN

      ENDIF

      END