C DEVRCO    SOURCE    CHAT      05/01/12    22:47:17     5004           
      SUBROUTINE DEVRCO(Q1,NA1,XPTB,NPLB,XPHILB,NSB,NPLSB,NA2,IDIMB,            
     &                  IBASB,IPLSB,INMSB,IORSB,IND,IAROTA)                            
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*--------------------------------------------------------------------*          
*                                                                    *          
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *          
*     ________________________________________________               *          
*                                                                    *          
*     Recombinaison des d{placements aux points de choc.             *          
*                                                                    *          
*     Param}tres:                                                    *          
*                                                                    *          
* e   Q1      Tableau des d{placements g{n{ralis{s.                  *          
* e   NA1     Nombre total d'inconnues en base A.                    *          
* es  XPTB    Tableau des d{placements des points sur base B.        *          
* e   NPLB    Nombre total de points intervenant dans les liaisons.  *          
* e   XPHILB  Tableau des vecteurs propres aux points de liaisons.   *          
* e   NSB     Nombre de sous base.                                   *          
* e   NPLSB   Nombre total de points intervenant dans les liaisons   *          
*             dans une sous base.                                    *          
* e   NA2     Nombre total d'inconnues dans une sous base.           *          
* e   IDIMB   Nombre total de ddl retenus.                           *          
* e   IBASB   Indique dans quelle sous base appartient le point de   *          
*             liaison.                                               *          
* e   INMSB   Indique le nombre d'inconnues de la sous base.         *          
* e   IORSB   Donne l'indice du premier mode dans l'ensemble des     *          
*             modes.                                                 *          
* e   IPLSB   Dans une sous base, indique la position du point de    *          
*             liaison.                                               *          
* e   IND     Indice du pas.                                         *          
*                                                                    *          
*                                                                    *          
*     Auteur, date de cr{ation:                                      *          
*                                                                    *          
*     Lionel VIVAN, le 22 Septembre 1989.                            *          
*                                                                    *          
*--------------------------------------------------------------------*          
*                                                                               
      INTEGER IBASB(*),INMSB(*),IORSB(*),IPLSB(*),IAROTA(*)                               
      REAL*8  XPHILB(NSB,NPLSB,NA2,*),Q1(NA1,*),XPTB(NPLB,4,*)                  
*                                                                               
      DO 10 IP = 1,NPLB                                                         
         ISB  = IBASB(IP)                                                       
         NA3  = INMSB(ISB)                                                      
         INA1 = IORSB(ISB) - 1                                                  
         IPLB = IPLSB(IP) 
         IROT  = IAROTA(ISB)                                                      
         DO 20 ID = 1,IDIMB                                                     
            XRET = 0.D0                                                         
            DO 30 IN = 1,NA3                                                    
               INN = INA1 + IN                                                  
               XRET = XRET + XPHILB(ISB,IPLB,IN,ID) * Q1(INN,IND)               
 30            CONTINUE  
*   Prise en compte des effets de rotation pour les corps rigides
            IF (IROT.NE.0) THEN 
                XANGLE=Q1(IROT,IND)
* Déplacements dus à la rotation
                XRET =XRET + XPHILB(ISB,IPLB,NA3+1,ID)* (COS(XANGLE)-1)                                  
                XRET =XRET + XPHILB(ISB,IPLB,NA3+2,ID)* SIN(XANGLE)  
            ENDIF                                
*           end do                                                              
            XPTB(IP,IND,ID) = XRET                                              
 20         CONTINUE                                                            
*        end do                                                                 
 10      CONTINUE                                                               
*     end do                                                                    
*                                                                               
      END