C RGBASE    SOURCE    CHAT      09/10/09    21:23:01     6519           
      SUBROUTINE RGBASE(IPOI2,IRIG,IRET)                                        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C=======================================================================        
C  CE SUBROUTINE ENCHAINE LES CALCULS DES RIGIDITES SUIVANTES :                 
C    . RIGIDITE DUES AUX MODES (MN OU KN) ....RGMODE                            
C    . COUPLAGE MODE-LIAISONS             ....RGLIMO                            
C    . COUPLAGE LIAISONS-LIAISONS         ....RGLILI                            
C  LE RESULTAT EST MIS DANS IRET                                                
C                                                                               
C  PROGRAMME PAR FARVACQUE                                                      
C  APPELE PAR RIGI                                                              
C  APPELLE RGLIMO FUSRIG RGLILI RIGMOD                                          
C=======================================================================        
-INC CCOPTIO                                                                    
-INC SMRIGID                                                                    
-INC SMBASEM                                                                    
-INC SMSOLUT                                                                    
-INC SMSTRUC                                                                    
-INC SMATTAC                                                                    
C                                                                               
      SEGMENT LIAT(NBASE)                                                       
      SEGMENT LRAT(0)                                                           
C                                                                               
      KRIGI=0                                                                   
      LRAT=0                                                                    
      IFLAT=0                                                                   
      LIAT=0                                                                    
      MBASEM=IPOI2                                                              
      SEGACT MBASEM                                                             
      NBASE=LISBAS(/1)                                                          
C                                                                               
C  ON TRAITE D ABORD LES OBJETS ATTACHE                                         
C  ON ENVOIT A RGMATT UN ATTACHE OU LES RIGIDITES SONT TOUTES                   
C  DIFFERENTES POUR NE PAS COMPTER PLUSIEURS FOIS LE MEME TERME                 
C                                                                               
      IF(IRIG.NE.2) GOTO 100                                                    
      SEGINI LIAT                                                               
      NLIA=0                                                                    
      DO 10 IA=1,NBASE                                                          
      MSOBAS=LISBAS(IA)                                                         
      SEGACT MSOBAS                                                             
      IF(IBSTRM(4).EQ.0) GO TO 12                                               
         DO 11 IAT=1,NLIA                                                       
         IF(IBSTRM(4).EQ.LIAT(IAT)) GO TO 12                                    
  11     CONTINUE                                                               
      NLIA=NLIA+1                                                               
      LIAT(NLIA)=IBSTRM(4)                                                      
  12  CONTINUE                                                                  
      SEGDES MSOBAS                                                       
  10  CONTINUE                                                                  
      IF(NLIA.EQ.0) GO TO 100                                                   
      IF(NLIA.EQ.1) THEN                                                        
         KATTAC=LIAT(1)                                                         
         GO TO 19                                                               
      ENDIF                                                                     
C                                                                               
      SEGINI LRAT                                                               
      DO 13 JAT=1,NLIA                                                          
      MATTAC=LIAT(JAT)                                                          
      SEGACT MATTAC                                                             
      DO 16 JJAT=1,LISATT(/1)                                                   
      MSOUMA=LISATT(JJAT)                                                       
      SEGACT MSOUMA                                                             
         DO 14 KAT=1,IPMATK(/1)                                                 
         IF(IPMATK(KAT).EQ.0)GO TO 14                                           
            DO 15 LAT=1,LRAT(/1)                                                
            IF(IPMATK(KAT).EQ.LRAT(LAT))GO TO 14                                
  15        CONTINUE                                                            
            LRAT(**)=IPMATK(KAT)                                                
  14     CONTINUE                                                               
      SEGDES MSOUMA                                                       
  16  CONTINUE                                                                  
      SEGDES MATTAC                                                       
  13  CONTINUE                                                                  
C                                                                               
C  ON CREE L ATTACHE SI BESOIN                                                  
C                                                                               
      IFLAT=1                                                                   
      N=1                                                                       
      SEGINI MATTAC                                                             
      KATTAC=MATTAC                                                             
      N=0                                                                       
      M=LRAT(/1)                                                                
      SEGINI MSOUMA                                                             
      LISATT(1)=MSOUMA                                                          
      ITYATT='MECA'                                                             
      IGEOCH=0                                                                  
      IPHYCH=0                                                                  
      DO 18 NLI=1,M                                                             
      IPMATK(NLI)=LRAT(NLI)                                                     
  18  CONTINUE                                                                  
C                                                                               
C  MATTAC ET MSOUMA SEGDESES DANS RGMATT                                        
C                                                                               
  19  CONTINUE                                                                  
      CALL RGMATT(KATTAC,KRIG)                                                  
      KRIGI=KRIG                                                                
C                                                                               
  100 CONTINUE                                                                  
      IF(LIAT.NE.0)SEGSUP LIAT                                                  
      IF(LRAT.NE.0)SEGSUP LRAT                                                  
      IF(IFLAT.NE.0)CALL DTMATT(KATTAC)                                         
      DO 1 IB=1,NBASE                                                           
      MSOBAS=LISBAS(IB)                                                         
      SEGACT MSOBAS                                                             
      ISTRU=IBSTRM(1)                                                           
      IMODE=IBSTRM(2)                                                           
      ISOLS=IBSTRM(3)                                                           
      IF(ISOLS.EQ.0) GO TO 4                                                    
      IF(IMODE.EQ.0) GO TO 1032                                                 
      IF(IRIG.EQ.2) GO TO 1032                                                  
      CALL RGLIMO(IMODE,ISOLS,ISTRU,IRIG,KRIG)                                  
      IF(IERR.NE.0) GO TO 2000                                                  
      IF(KRIG.EQ.0) GO TO 1032                                                  
      IF(KRIGI.EQ.0) THEN                                                       
         KRIGI=KRIG                                                             
      ELSE                                                                      
         CALL FUSRIG(KRIGI,KRIG,IRET)                                           
         MRIGID=KRIGI                                                           
         SEGSUP MRIGID                                                          
         KRIGI=IRET                                                             
      ENDIF                                                                     
 1032 CALL RGLILI(ISOLS,ISTRU,IRIG,KRIG)                                        
      IF(IERR.NE.0) GO TO 2000                                                  
      IF(KRIG.EQ.0) GO TO 4                                                     
      IF(KRIGI.EQ.0) THEN                                                       
         KRIGI=KRIG                                                             
      ELSE                                                                      
         CALL FUSRIG(KRIGI,KRIG,IRET)                                           
         MRIGID=KRIGI                                                           
         SEGSUP MRIGID                                                          
         KRIGI=IRET                                                             
      ENDIF                                                                     
 4    CONTINUE                                                                  
      IF(IMODE.EQ.0) GO TO 1036                                                 
      CALL RIGMOD(IMODE,IRIG,KRIG)                                              
      IF(IERR.NE.0) GO TO 2000                                                  
      IF(KRIGI.EQ.0) THEN                                                       
         KRIGI=KRIG                                                             
      ELSE                                                                      
         CALL FUSRIG(KRIGI,KRIG,IRET)                                           
         MRIGID=KRIGI                                                           
         SEGSUP MRIGID                                                          
         KRIGI=IRET                                                             
      ENDIF                                                                     
 1036 CONTINUE                                                                  
      SEGDES MSOBAS                                                             
 1    CONTINUE                                                                  
      SEGDES MBASEM                                                             
C                                                                               
      IRET=KRIGI                                                                
 2000 CONTINUE                                                                  
      RETURN                                                                    
      END