C RCCONT    SOURCE    FANDEUR   10/12/14    21:19:11     6812           
      SUBROUTINE RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA)               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*--------------------------------------------------------------------*          
*                                                                    *          
*     Recombine le chpoint ICHPT en contrainte.                     *           
*                                                                    *          
*     Param}tres:                                                    *          
*                                                                    *          
* e   ITBAS   table repr{sentant une base modale                     *          
* e   ICHPT   chpoint modal @ recombiner                             *          
* e   KCHAR   chargement de la structure                             *          
* e   XTEMP   temps de recombinaison                                 *          
* e   ITRES   table r{sultat issue de l'op{rateur DYNE               *          
* e   IPOS    position de XTEMP dans le listreel des temps           *          
* e   ITLIA   table des liaisons                                     *          
*                                                                    *          
*     Auteur, date de cr{ation:                                      *          
*                                                                    *          
*     Lionel VIVAN, le 26 avril 1990.                                *          
*                                                                    *          
*--------------------------------------------------------------------*          
-INC CCOPTIO                                                                    
-INC SMCHPOI                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
      SEGMENT TRAV(NPOIN)*D                                                     
      LOGICAL L0,L1                                                             
      CHARACTER*8 TYPRET,CHARRE                                                 
      CHARACTER*40 TYPBAS                                                       
*                                                                               
*     on met les contributions modales ICHPT dans ICPR et TRAV                  
*                                                                               
      MCHPOI = ICHPT                                                            
      IF (MCHPOI.EQ.0) THEN                                                     
*        le CHPOINT des contributions modales est nul                           
         MOTERR(1:8) = 'RCCONT'                                                 
         CALL ERREUR(170)                                                       
         RETURN                                                                 
      ENDIF                                                                     
      SEGINI ICPR                                                               
      KCPR = ICPR                                                               
      SEGACT MCHPOI                                                             
      NSOU = IPCHP(/1)                                                          
      IKI = 0                                                                   
      DO 10 ISOU = 1,NSOU                                                       
         MSOUPO = IPCHP(ISOU)                                                   
         SEGACT MSOUPO                                                          
*        on cherche un CHPOINT qui contient des contributions modales           
         IF (NOCOMP(/2).NE.1) THEN                                              
            CALL ERREUR(188)                                                    
            SEGDES MSOUPO                                                 
            SEGDES MCHPOI                                                 
            GOTO 991
         ENDIF                                                                  
         IF (NOCOMP(1).NE.'ALFA') THEN                                          
            CALL ERREUR(188)                                                    
            SEGDES MSOUPO                                                 
            SEGDES MCHPOI                                                 
            GOTO 991
         ENDIF                                                                  
         MELEME = IGEOC                                                         
         SEGACT MELEME                                                          
         N2 = NUM(/2)                                                           
         DO 12 I = 1,N2                                                         
            IKI = IKI + 1                                                       
            ICPR(NUM(1,I)) = IKI                                                
 12      CONTINUE                                                               
         SEGDES MELEME,MSOUPO                                       
 10   CONTINUE                                                                  
      NPOIN = IKI                                                               
      SEGINI TRAV                                                               
      KTRAV = TRAV                                                              
      IKI = 0                                                                   
      DO 20 ISOU = 1,NSOU                                                       
         MSOUPO = IPCHP(ISOU)                                                   
         SEGACT MSOUPO                                                          
         MPOVAL = IPOVAL                                                        
         SEGACT MPOVAL                                                          
         N2 = VPOCHA(/1)                                                        
         DO 22 I = 1,N2                                                         
            IKI = IKI + 1                                                       
            TRAV(IKI) = VPOCHA(I,1)                                             
 22      CONTINUE                                                               
         SEGDES MPOVAL,MSOUPO                                       
 20   CONTINUE                                                                  
      SEGDES MCHPOI                                                       
*                                                                               
      CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,                          
     &                  'MOT',I1,X1,TYPBAS,L1,IP1)                              
*                                                                               
*     Cas oš la base est unique                                                 
*                                                                               
      IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN                                   
         CALL RCCON2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS,             
     &               ITLIA)                                                     
         IF (IERR.NE.0) GOTO 990                                                
*                                                                               
*     Cas oš on a un ensemble de bases                                          
*                                                                               
      ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN                        
*                                                                               
*        On boucle sur le nombre de bases                                       
*                                                                               
         IB = 0                                                                 
 30      CONTINUE                                                               
         TYPRET = ' '                                                           
         IB = IB + 1                                                            
         CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,                           
     &                       TYPRET,I1,X1,CHARRE,L1,ITTBAS)                     
         IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN                       
            CALL RCCON2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS,          
     &               ITLIA)                                                     
            IF (IERR.NE.0) GOTO 990                                             
            IF (IB.EQ.1) THEN                                                   
               ICHCO = IRET                                                     
            ELSE                                                                
               N1 = 1                                                           
               CALL ADCHEL(ICHCO,IRET,ICHCO,N1)                                 
            ENDIF                                                               
            GOTO 30                                                             
         ENDIF                                                                  
      ENDIF                                                                     
*                                                                               
      CALL ECROBJ('MCHAML',ICHCO)                                               
*                                                                               
 990  CONTINUE                                                                  
      SEGSUP,TRAV                                                               
 991  CONTINUE                                                                  
      SEGSUP,ICPR                                                               
*                                                                               
      RETURN                                                                    
      END