C RECANG    SOURCE    CHAT      05/01/13    02:46:30     5004           
        SUBROUTINE RECANG(ITRES,IPOS,IPTR,XANGLE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*--------------------------------------------------------------------*          
*                                                                    *          
*     Recherche le déplacements généralisé de rotation               *          
*                                                                    *          
*     Param}tres:                                                    *          
*                                                                    *          
* e   ITRES   table résultat issue de l'opérateur Dyne               *          
* e   IPOS    position de XTEMP dans le listreel des temps           *          
* e   IPTR    point de repère du mode de rotation,dans la base modale*
* es  XANGLE  valeur de la rotation                                  *          
*     Auteur, date de création:                                      *          
*                                                                    *          
*     Samuel DURAND le 15 Octobre 1996.                              *          
*                                                                    *          
*--------------------------------------------------------------------*  
-INC CCOPTIO        
-INC SMCHPOI                                                                    
-INC SMELEME                                                                    
      LOGICAL L0,L1                                                            
* Recherche du champoint des déplacements généralisés      
      CALL ACCTAB(ITRES,'ENTIER',IPOS,X0,' ',L0,IP0,                         
     &                      'TABLE',I1,X1,' ',L1,ITDEP)                         
      CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,                 
     &                    'CHPOINT',I1,X1,' ',L1,ICHPT)                         
      MCHPOI = ICHPT                                                            
      IF (MCHPOI.EQ.0) THEN                                                     
*        le CHPOINT des déplacements modaux est nul                           
         MOTERR(1:8) = 'RCDEPL'                                                 
         CALL ERREUR(170)                                                       
         RETURN                                                                 
      ENDIF                                                                     
      SEGACT MCHPOI 
      NSOU = IPCHP(/1)                                                          
      DO 10 ISOU = 1,NSOU                                                       
         MSOUPO = IPCHP(ISOU)                                                   
         SEGACT MSOUPO                                                          
*        on cherche la valeur du champ correspondant au point de
*        rotation          
         MELEME = IGEOC                                                         
         SEGACT MELEME                                                          
         MPOVAL = IPOVAL                                                        
         SEGACT MPOVAL                                                          
         N2 = NUM(/2)                                                           
         DO 12 I = 1,N2                                                         
            IF (NUM(1,I).EQ.IPTR) THEN
                XANGLE=VPOCHA(I,1)
            ENDIF
 12      CONTINUE
         SEGDES MPOVAL,MELEME,MSOUPO
 10    CONTINUE
       SEGDES MCHPOI
*
       END