C DEVMOM    SOURCE    CHAT      05/01/12    22:46:46     5004           
        SUBROUTINE DEVMOM(FTOTB,Q1,FEXB,XPHILB,IAROTA,IBASB,IPLSB,
     &                    INMSB,NA2,NA1,NSB,NPLSB,NPLB,IND,IDIM)        
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8(A-H,O-Z)
*-------------------------------------------------------------------*
*                                                                   *
*     Opérateur DYNE : algorithme de Fu - de Vogelaere              *
*     ________________________________________________              *
*                                                                   *
*     Mise en oeuvre de l'algorithme.                               *
*     Pour le cas des corps rigides, calcul des moments dus aux     *
*     forces sur base B.                                            *
*                                                                   *
*     Paramètres:                                                   *
*                                                                   *
* es  FTOTB  Forces totalisées sur la base B (choc + moment)        *
* e   FEXB   Forces extérieures sur Base B,intervenant dans le      *   
*            calcul des moments                                     *
* e   XPHILB Tableau contenant les déformées modales                *
* e   IAROTA Indique la position des modes de rotation              *
* e   IBASB  Indique à quelle sous base appartient le point de      *
*            liaison                                                *
* e   IPLSB  Indique la position du point dans la sous base         *
* e   INMSB  Indique le nombre de modes de la sous base             *
* e   Q1     Tableau des déplacements généralisés                   *
* e   NA1    Nombre total de modes                                  *
* e   NSB    Nombre de sous bases                                   *
* e   NPLB   Nombre de points intervenant dans les liaisons         *
* e                                                                 *
*                                                                   *
*                                                                   *                                                   
*     Auteur, date de creation:                                     *
*                                                                   *
*     Samuel DURAND, le 07 Octobre 1996  .                          *
*                                                                   *
*-------------------------------------------------------------------*
*
        INTEGER IBASB(*),IAROTA(*),IPLSB(*),INMSB(*)
        REAL*8  XPHILB(NSB,NPLSB,NA2,*),Q1(NA1,*)
        REAL*8  FEXB(NPLB,2,*),FTOTB(NPLB,*)
        REAL*8  XCDG(3),FORCE(3)
*
        DO 10 IP=1,NPLB
            ISB=IBASB(IP)
            IROT=IAROTA(ISB)
            IPSB = IPLSB(IP)
            NA3 = INMSB(ISB)    
            IF (IROT.NE.0) THEN
                XANGLE=Q1(IROT,IND)
                DO 20 ID=1,IDIM
*   Calcul du vecteur GP
                    XCDG(ID) =  XPHILB(ISB,IPSB,NA3+1,ID)*COS(XANGLE) +
     &                          XPHILB(ISB,IPSB,NA3+2,ID)*SIN(XANGLE)
*   Totalisations des forces
                    FORCE(ID) = FEXB(IP,IND,ID)+FTOTB(IP,ID)
 20             CONTINUE
*   Produit vectoriel GP^F
                IF (IDIM.EQ.3) THEN
        FTOTB(IP,4) = FTOTB(IP,4) + XCDG(2)*FORCE(3) - XCDG(3)*FORCE(2) 
        FTOTB(IP,5) = FTOTB(IP,5) + XCDG(3)*FORCE(1) - XCDG(1)*FORCE(3) 
        FTOTB(IP,6) = FTOTB(IP,6) + XCDG(1)*FORCE(2) - XCDG(2)*FORCE(1) 
                ELSE
        FTOTB(IP,3) =FTOTB(IP,3) + XCDG(1)*FORCE(2) - XCDG(2)*FORCE(1) 
                ENDIF             
            ENDIF
 10     CONTINUE
*
        END
*