C D2VLF2    SOURCE    CHAT      05/01/12    22:35:38     5004           
C DEVLF2    SOURCE    LAVARENN  96/10/30    21:18:02     2349           
      SUBROUTINE D2VLF2(Q1,Q2,FTOTA,XM,NA1,IPALB,IPLIB,XPALB,XVALB,
     &                  NLIAB,XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,
     &                  XPTB,XDT,NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,
     &                  NPLSB,NA2,IND,FEXPSM,NPC1,IERRD,FTEST2,
     &                  FTOTB0,XABSCI,XORDON,NIP,IAROTA,RIGIDE,
     &                  FEXB,XCHPFB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Initialisation pour calcul des forces de choc base B.          *
*                                                                    *
*     Paramètres:                                                    *
*                                                                    *
* e   Q1(.,.) Vecteur des déplacements généralisés.
* e   Q2      vecteur des vitesses generalises                       *
* es  FTOTA   Forces extérieures totalisées sur la base A.           *
* e   XM      Vecteur des masses généralisées.                       *
* e   NA1     Nombre total d'inconnues en base A.                    *
* e   IPALB   Renseigne sur le type de la liaison.                   *
* e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.    *
* e   IAROTA  Indique la position des modes de rotation              *
* e   XPALB   Tableau contenant les paramètres de la liaison.        *
* es  XVALB   Tableau contenant les variables internes des liaisons  *
* e   NLIAB   Nombre de liaisons sur la base B.                      *
* e   XPHILB  Tableau des vecteurs propres aux points de liaisons.   *
* e   JPLIB   Tableau contenant les numéros "GIBI" des liaisons.     *
* e   NPLB    Nombre total de points intervenant dans les liaisons.  *
* e   IDIMB   Nombre de directions.                                  *
* e   IND     Indice du pas.                                         *
* 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    *
*             pour la liaison point-point- ... -plastique            *
* e   RIGIDE  Vrai si l'on a un corps rigide                         *
*                                                                    *
* -   FTEST2  Tableau local FTEST de la subroutine D2VLB1            *
* -   FTOTB0  Tableau local FTOTB0 de la subroutine D2VLB1           *
*                                                                    *
*                                                                    *
*     Auteur, date de création:                                      *
*                                                                    *
*     Bertrand BEAUFILS : le 27 juillet 1990.                        *
*     Ianis Politopoulos 22 /02 /93  DEVRCO ---> DEVCOI              *
*--------------------------------------------------------------------*
*
      INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*)
      INTEGER IBASB(*),IPLSB(*),INMSB(*),IORSB(*),IAROTA(*)
      REAL*8  XPALB(NLIAB,*),Q1(NA1,*),Q2(NA1,*),FTOTA(NA1,*),XM(*)
      REAL*8  XVALB(NLIAB,4,*),XPHILB(NSB,NPLSB,NA2,*),XPTB(NPLB,4,*)
      REAL*8  XDT(*),FTOTB(NPLB,*),FTOTBA(*),FEXPSM(NPLB,NPC1,2,*)
      REAL*8  XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*)
      REAL*8  XCHPFB(2,NLIAB,4,NPLB)
      LOGICAL RIGIDE
*
      DO 20 IP = 1,NPLB
         DO 30 ID = 1,IDIMB
            FTOTB(IP,ID) = 0.D0
 30         CONTINUE
*        end do
 20      CONTINUE
*     end do
           IF (IDIMB.EQ.6) THEN
              IDIM = 3
           ELSE
              IDIM = 2
           ENDIF
*
*     Recombinaison des déplacements aux points de choc
*
      CALL D2VCOI(Q1,Q2,XDT,NA1,XPTB,NPLB,XPHILB,NSB,NPLSB,NA2,IDIMB,
     &            IBASB,IPLSB,INMSB,IORSB,IND,IAROTA)
*
*     Initialisation des tableaux contenants les paramètres de liaison
*
      CALL DEVLB2(IPLIB,IPALB,XPALB,XPTB,NLIAB,IND,IDIMB,NPLB,
     &            XABSCI,XORDON,NIP)
*
*     Calcul des forces de choc sur base B
*
      CALL D2VLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB,
     &            NPLB,IDIMB,XDT,NPAS,IND,FEXPSM,NPC1,IERRD,
     &            FTEST2,FTOTB0,XABSCI,XORDON,NIP,XCHPFB)
      IF (IERRD.NE.0) RETURN
*
*     Calcul des moments
*
      IF (RIGIDE) THEN
           CALL DEVMOM(FTOTB,Q1,FEXB,XPHILB,IAROTA,IBASB,IPLSB,INMSB,
     &                 NA2,NA1,NSB,NPLSB,NPLB,1,IDIM)
      ENDIF
*
*     Projection des forces base B sur base A
*
      CALL DEVPRO(XPHILB,FTOTB,FTOTBA,IBASB,INMSB,IPLSB,IORSB,NSB,
     &            NPLSB,NA2,IDIMB,NPLB,NA1)
*
*     Ajout des forces projetées aux forces extérieures sur base A
*
      DO 10 I = 1,NA1
         FTOTA(I,IND) = FTOTA(I,IND) + FTOTBA(I)
 10      CONTINUE
*     end do
*
      END