C DEVFB7    SOURCE    BP208322  20/09/18    21:15:32     10718          
C DEVFB6    SOURCE    LAVARENN  96/10/30    21:16:12     2349
      SUBROUTINE DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Calcul des forces de choc sur base B pour les liaisons de      *
*     type LIGNE_CERCLE                                            *
*                                                                    *
*     Paramètres:                                                    *
*                                                                    *
* e   ITYP    type de la liaison.                                    *
* es  FTOTB   Forces extérieures totalisées sur la base B.           *
* e   XPTB    Tableau des déplacements des points                    *
* e   IPALB   Renseigne sur la liaison.                              *
* e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.    *
* e   XPALB   Tableau contenant les paramètres de la liaison.        *
* es  XVALB   Tableau contenant les variables internes de liaisons.  *
* es  XCHPFB  Tableau contenant les valeurs des futurs chpoints      *
* e   NLIAB   Nombre de liaisons sur la base B.                      *
* e   NPLB    Nombre total de points intervenant dans les liaisons.  *
* e   IND     Indice du pas.                                         *
* e   I       numéro de la liaison.                                  *
*                                                                    *
*                                                                    *
*     Auteur, date de création:                                      *
*                                                                    *
*     Ibrahim PINTO, 05/97                                           *
*--------------------------------------------------------------------*
*
      INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
      REAL*8  XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*)
      REAL*8  XVALB(NLIAB,4,*),XCHPFB(2,NLIAB,4,*)
*
*  Initialisations
*
*
        XVALB(I,IND,1) =0.D0
        XVALB(I,IND,3) =0.D0
        XVALB(I,IND,4) =0.D0
        XVALB(I,IND,5) =0.D0
        XVALB(I,IND,6) =0.D0
        XVALB(I,IND,10) = 0.D0
        XVALB(I,IND,11) = 0.D0
        XVALB(I,IND,12) = 0.D0
        IDIM = IPALB(I,3)
        IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
           ID1 = 6
        ELSE
           ID1 = 7
        ENDIF
        NNOEES = IPALB(I,22)
        NNOEMA=IPALB(I,21)
        IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
        ICH = 26 + NNOEMA+NNOEES
        ICG = 26 + 2*(NNOEMA+NNOEES)
        DO 5 J=1,(NNOEMA+NNOEES)
           IPALB(I,ICH+J) = 0
           IPALB(I,ICG+J) = 0
           DO 7 ID=1,IDIM
              XPALB(I,IFO+ID) = 0.D0
 7         CONTINUE
           IFO = IFO + IDIM
 5      CONTINUE
        IF (IDIM.EQ.3) THEN
            IDIMB=6
        ELSE
            IDIMB=3
        ENDIF
        DO 8 IP=1,NPLB
              XCHPFB(1,I,IND,IP)=0.D0
              XCHPFB(2,I,IND,IP)=0.D0
 8      CONTINUE
*******************************************************************
* On s'intéresse au choc des noeuds esclaves sur le maillage maitre
*******************************************************************



      ILOCAL=IPALB(I,23)
      ISYM = IPALB(I,26)


      IF (ISYM.EQ.1 .OR. ISYM.EQ.0) THEN

********************************************************************
* On s'intéresse au choc des noeuds maitres sur le maillage esclave*
********************************************************************

* Recherche des plus proches voisins
      CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1)
* Boucle sur tous les noeuds MAITRES
        DO 10 IESC=1,NNOEMA
        CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
     &,IND2,PDTS2,I,IANNUL,IESC,1,XCHPFB)
 10     CONTINUE


      ELSE


********************************************************************
* On s'intéresse au choc des noeuds esclaves sur le maillage maitre*
********************************************************************

* Recherche des plus proches voisins
       CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0)
* Boucle sur tous les noeuds esclaves
        DO 20 IESC=1,NNOEES
        CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
     &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB)
 20     CONTINUE

      ENDIF


           IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
           DO 40 INOE=1,(NNOEMA+NNOEES)
              DO 42 ID=1,IDIM
                  FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
     &XPALB(I,IFO+ID)
 42           CONTINUE
              IFO = IFO+IDIM
 40        CONTINUE
*
*

       END