C EVORIG    SOURCE    PV090527  24/12/25    21:15:03     12109          
      SUBROUTINE EVORIG(IROT,ICDG,IBOO,ILEX,ITYP,ILEXRO,ILEXVI,IDEFO)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*-----------------------------------------------------------------------*
*                                                                       *
*    Sous-programme appelé par EVRECO de l'opérateur EVOL option RECO   *
*                                                                       *
*       Pour les rotations de corps rigides, recombine les déplacements *     *
*    les vitesses ou les accélérations .                                *
*                                                                       *
*                                                                       *
*     Paramètres                                                        *
*                                                                       *
* e  IROT   Position du mode de rotation                                *
* e  ICDG   Numéro du point centre de gravité                           *
* e  IDEFO  Numéro de la déformée modale de rotation                    *
* e  ITYP   = 0 si on recombine les déplacements                        *
*           = 1 pour les vitesses                                       *
*           =-1 pour les accélérations                                  *
*           = 2 pour les contraintes                                    *
* es IBOO   Segment des résultats                                       *
* e  ILEX   Suite des chpoints des contributions modales                *
* e  ILEXRO Suite des chpoints des déplacements modaux                  *
*                              (sert pour les vitesses et accélérations)*
* e  ILEXVI Suite des chpoints des vitessess modales                    *
*                              (sert pour les   accélérations)          *
*                                                                       *
*                                                                       *
*     Auteur, date de création:                                         *
*                                                                       *
*     Samuel DURAND      : le 14 Octobre 1996 : Création                *
*                                                                       *
*-----------------------------------------------------------------------*
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMLREEL
-INC SMCHPOI
-INC SMELEME
-INC SMCOORD
*
      SEGMENT NUMOO
       INTEGER NUMO(N),KLIST(N)
       CHARACTER*(LOCHPO) NUDDL(N)
      ENDSEGMENT
*
      CHARACTER*4 MOTCOM
      CHARACTER*4 NOMTRI(3)
      REAL*8 XAXROT(3),XDROTA(2,6)
*
      DATA NOMTRI/'UX  ','UY  ','UZ  '/
*
      segact mcoord
*
* Création d'un listréel composé des valeurs du mode
* de rotation au cours du temps
*
       MLENTI=ILEX
       SEGACT MLENTI
       LTEMP=LECT(/1)
* Recherche de la position du mode de rotation, dans le premier
* chpoint des variables généralisées
       MCHPOI=LECT(1)
       SEGACT MCHPOI
       NSOUP=IPCHP(/1)
       KT=0
 15    CONTINUE
          KT=KT+1
          MSOUPO=IPCHP(KT)
          SEGACT MSOUPO
          MELEME = IGEOC
          SEGACT MELEME
          NE = NUM(/2)
          IE=0
 16       CONTINUE
             IE=IE+1
             IF ((NUM(1,IE).EQ.IROT)) THEN
*               RIEN
                SEGDES MELEME,MSOUPO
             ELSE
                IF (IE.NE.NE) THEN
                    GOTO 16
                ELSE
                    SEGDES MELEME,MSOUPO
                    GOTO 15
                ENDIF
             ENDIF
       SEGDES MCHPOI
*
* Boucle sur tous les instants pour remplir le listréel
       JG = LTEMP
       SEGINI,MLREEL
       DO 20 JT=1,LTEMP
          MCHPOI=LECT(JT)
          SEGACT MCHPOI
          MSOUPO=IPCHP(KT)
          SEGACT MSOUPO
          MPOVAL=IPOVAL
          SEGACT MPOVAL
          MLREEL.PROG(JT)=VPOCHA(IE,1)
          SEGDES MPOVAL,MSOUPO,MCHPOI
 20    CONTINUE
       SEGDES MLENTI
       IF (ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
* Récupération des angles de rotation à chaque pas de temps
          JG=LTEMP
          SEGINI MLREE2
          MLENTI=ILEXRO
          SEGACT MLENTI
          DO 21 JT=1,LTEMP
              MCHPOI=LECT(JT)
              SEGACT MCHPOI
              MSOUPO=IPCHP(KT)
              SEGACT MSOUPO
              MPOVAL=IPOVAL
              SEGACT MPOVAL
              MLREE2.PROG(JT)=VPOCHA(IE,1)
              SEGDES MPOVAL,MSOUPO,MCHPOI
 21       CONTINUE
          SEGDES MLENTI
          IF (ITYP.EQ.-1) THEN
* Récupération des vitesses de rotation à chaque pas de temps
            JG=LTEMP
            SEGINI MLREE3
            MLENTI=ILEXVI
            SEGACT MLENTI
            DO 22 JT=1,LTEMP
              MCHPOI=LECT(JT)
              SEGACT MCHPOI
              MSOUPO=IPCHP(KT)
              SEGACT MSOUPO
              MPOVAL=IPOVAL
              SEGACT MPOVAL
              MLREE3.PROG(JT)=VPOCHA(IE,1)
              SEGDES MPOVAL,MSOUPO,MCHPOI
 22         CONTINUE
            SEGDES MLENTI
*
          else
*            rien
          ENDIF
       else
*         rien
       ENDIF
       NUMOO = IBOO
       SEGACT NUMOO
       N=NUMO(/1)
*
*
* Boucle sur tous les points de recombinaison
**
          IF (IDIM.EQ.3) THEN
             IDIMB=6
          ELSE
             IDIMB=3
          ENDIF
       DO 10 IPOINT=1,N
          MERR=0
* Recherche de l axe de rotation
          MCHPOI=IDEFO
          SEGACT,MCHPOI
          NSO=IPCHP(/1)
          ISOU=0
 11       CONTINUE
             ISOU=ISOU+1
             MSOUPO=IPCHP(ISOU)
             SEGACT,MSOUPO
             MELEME=IGEOC
             SEGACT,MELEME
             MPOVAL=IPOVAL
             SEGACT,MPOVAL
             NEL=NUM(/2)
             IE=0
 12          CONTINUE
                IE=IE+1
                IF (NUM(1,IE).EQ.NUMO(IPOINT)) THEN
                    DO 13 ID=(IDIM+1),IDIMB
                        XAXROT(ID-IDIM)=VPOCHA(IE,ID)
 13                 CONTINUE
                    SEGDES MPOVAL,MELEME,MSOUPO
                ELSE
                    IF (IE.NE.NEL) THEN
                       GOTO 12
                    ELSE
                       SEGDES MPOVAL,MELEME,MSOUPO
                       GOTO 11
                    ENDIF
                ENDIF
                SEGDES MCHPOI
*
          CALL DYNE41(XAXROT,MERR,IDIM)
*       Calcul des fausses déformées modales de rotation
          CALL DYNE42(XDROTA,XAXROT,NUMO(IPOINT),ICDG,IDIMB,MERR)
          MOTCOM=NUDDL(IPOINT)
          CALL PLACE5(NOMTRI,IDIM,IPOSI,MOTCOM)
          IF (IPOSI.NE.0) THEN
*          Boucle sur tous les instants
*
             MLREE1=KLIST(IPOINT)
             SEGACT MLREE1*MOD
             DO 30 IT=1,LTEMP
                 XVAL=MLREEL.PROG(IT)
               IF (ITYP.EQ.0) THEN
                 MLREE1.PROG(IT)=MLREE1.PROG(IT)+(XDROTA(1,IPOSI)*
     &(COS(XVAL)-1) + XDROTA(2,IPOSI)*SIN(XVAL))
               ELSE
                 XANG=MLREE2.PROG(IT)
                 MLREE1.PROG(IT)=MLREE1.PROG(IT)+XVAL*
     &(COS(XANG)*XDROTA(2,IPOSI)-SIN(XANG)*XDROTA(1,IPOSI))
                 IF (ITYP.EQ.-1) THEN
                    XVIT=MLREE3.PROG(IT)
                    MLREE1.PROG(IT)=MLREE1.PROG(IT)-XVIT*XVIT*
     &(COS(XANG)*XDROTA(1,IPOSI)+SIN(XANG)*XDROTA(2,IPOSI))
                 else
*                   rien
                 ENDIF
               ENDIF
 30          CONTINUE
             SEGDES MLREE1
          else
*            rien
          ENDIF
 10    CONTINUE
       SEGSUP,MLREEL
       IF (ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
           SEGSUP MLREE2
           IF (ITYP.EQ.-1) SEGSUP MLREE3
        else
*           rien
        ENDIF
       END