Sources Esope | Cast3M

devrco
C DEVRCO    SOURCE    BP208322  20/09/18    21:15:42     10718          
      SUBROUTINE DEVRCO(Q1,Q2,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)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Recombinaison des deplacements aux points de choc.             *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   Q1      Tableau des deplacements generalises.                  *
* e   NA1     Nombre total d'inconnues en base A.                    *
* es  XPTB    Tableau des deplacements des points sur base B.        *
*new:                 et de la vitesse                               *
* 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.                                         *
*                                                                    *
*--------------------------------------------------------------------*
*
      INTEGER IBASB(*),INMSB(*),IORSB(*),IPLSB(*),IAROTA(*)
      REAL*8  XPHILB(NSB,NPLSB,NA2,*),Q1(NA1,*),Q2(NA1,*),XPTB(NPLB,2,*)
*
c     boucle sur les points de la liaison
      DO 10 IP = 1,NPLB
         ISB  = IBASB(IP)
         NA3  = INMSB(ISB)
         INA1 = IORSB(ISB) - 1
         IPLB = IPLSB(IP)
         IROT = IAROTA(ISB)
cbp      sortie de la boucle des calculs de cos et sin
         IF (IROT.NE.0) THEN
           XANGLE=Q1(IROT,IND)
           VITROT=Q2(IROT,IND)
           XCOS  =COS(XANGLE)
           XSIN  =SIN(XANGLE)
           XCOS1 =XCOS - 1.
         ENDIF
c        boucle sur les ddls
         DO 20 ID = 1,IDIMB
            XRET = 0.D0
            XRETV= 0.D0
c           boucle sur les modes
            DO 30 IN = 1,NA3
               INN = INA1 + IN
               XRET = XRET + XPHILB(ISB,IPLB,IN,ID) * Q1(INN,IND)
               XRETV= XRETV+ XPHILB(ISB,IPLB,IN,ID) * Q2(INN,IND)
 30         CONTINUE
*           Prise en compte des effets de rotation pour les corps rigides
            IF (IROT.NE.0) THEN
cbp                XANGLE=Q1(IROT,IND)
*               Déplacements dus à la rotation
cbp                XRET =XRET + XPHILB(ISB,IPLB,NA3+1,ID)* (COS(XANGLE)-1)
cbp                XRET =XRET + XPHILB(ISB,IPLB,NA3+2,ID)* SIN(XANGLE)
                XRET =XRET + XPHILB(ISB,IPLB,NA3+1,ID)*XCOS1
                XRET =XRET + XPHILB(ISB,IPLB,NA3+2,ID)*XSIN
                XRETV=XRETV+VITROT*(XCOS*XPHILB(ISB,IPLB,NA3+2,ID)
     &                             -XSIN*XPHILB(ISB,IPLB,NA3+1,ID))
            ENDIF
            XPTB(IP,1,ID) = XRET
            XPTB(IP,2,ID) = XRETV
 20      CONTINUE
 10   CONTINUE
*
      END