C DYNE01    SOURCE    CHAT      09/10/09    21:17:29     6519           
      SUBROUTINE DYNE01(ICHOLX,IRSCPR,IPRIGM,IVEC)                              
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
************************************************************************        
*                                                                               
*                             D Y N E 0 1                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*     UTILITAIRE DE L'OPERATEUR "DYNE"                                          
*     LUMPAGE ET INVERSION DE LA MATRICE MASSE                                  
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
* -----------                                                                   
*                                                                               
*     ICHOLX  (E)  POINTEUR SUR LE SEGMENT MMATRI ( ACTIF )                     
*     IRSCPR  (E)  POINTEUR SUR LE SEGMENT ICPR ( ACTIF )                       
*     IPRIGM  (E)  POINTEUR SUR L'OBJET RIGIDITE M                              
*     IVEC    (S)  VECTEUR CONTENANT LA MATRICE LUMPEE INVERSEE                 
*                  ( LAISSE ACTIF )                                             
*                                                                               
* REMARQUES:                                                                    
* ----------                                                                    
*     ATTENTION : ON NE LUMPE QUE LES TERMES RELATIFS AUX DDL                   
*     DE TRANSLATION ; EN CE QUI CONCERNE LES DDL DE ROTATION,                  
*     SEULS LES TERMES DIAGONAUX SONT PRIS EN COMPTE.                           
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*     DENIS ROBERT, LE 15 NOVEMBRE 1988.                                        
*                                                                               
*     MODIF 03/89 :  SUPPRESSION DU TEST SUR LA VALEUR DU TERME LUMPE           
*     ( E DE LANGRE)                                                            
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
* MODULES UTILISES:                                                             
*                                                                               
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMRIGID                                                                    
-INC SMMATRI                                                                    
-INC SMVECTD                                                                    
-INC SMCOORD                                                                    
*                                                                               
      PARAMETER ( UN = 1.D0 )                                                   
      PARAMETER ( EPS = 1.D-10 )                                                
      PARAMETER ( ZERO = 0.D0 )                                                 
*                                                                               
      CHARACTER*4 NI                                                            
*                                                                               
*---  SEGMENTS DE TRAVAIL                                                       
*                                                                               
      SEGMENT MUITRA(NLIGRE)                                                    
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
*                                                                               
      MVECTD=IVEC                                                               
      MMATRI=ICHOLX                                                             
      MINCPO=IINCPO                                                             
      SEGACT,MINCPO                                                             
      MIMIK=IIMIK                                                               
      SEGACT,MIMIK                                                              
      MIDUA=IIDUA                                                               
      SEGACT,MIDUA                                                              
      MHARK=IHARK                                                               
      SEGACT,MHARK                                                              
      ICPR=IRSCPR                                                               
      ININC=IMIK(/2)                                                            
*                                                                               
*---  BOUCLE SUR LES ZONES ELEMENTAIRES DE LA RIGIDITE                          
*                                                                               
      MRIGID=IPRIGM                                                             
      NRIGEL=IRIGEL(/2)                                                         
      DO 20 IRI=1,NRIGEL                                                        
         MELEME=IRIGEL(1,IRI)                                                   
         SEGACT,MELEME                                                          
         DESCR=IRIGEL(3,IRI)                                                    
         SEGACT,DESCR                                                           
*                                                                               
*---     ON REMPLIT MUITRA(IN)=IJ QUI DIT QUE LA IEME INCONNUE                  
*---     DE LA MATRICE ELEMENTAIRE EST LA JEME DE ININC                         
*                                                                               
         NLIGRE=LISINC(/2)                                                      
         SEGINI MUITRA                                                          
         DO 21 IN=1,NLIGRE                                                      
            NI=LISINC(IN)                                                       
            DO 22 IJ=1,ININC                                                    
               IF(NI.EQ.IMIK(IJ))  GO TO 23                                     
 22            CONTINUE                                                         
*           END DO                                                              
 23         CONTINUE                                                            
            IF (NI(1:1).EQ.'R') THEN                                            
               MUITRA(IN)=-IJ                                                   
            ELSE                                                                
               MUITRA(IN)=IJ                                                    
            ENDIF                                                               
 21         CONTINUE                                                            
*        END DO                                                                 
*                                                                               
*---     BOUCLE SUR LES MATRICES TRES ELEMENTAIRES                              
*                                                                               
         N1=NUM(/1)                                                             
         N2=NUM(/2)                                                             
         xMATRI=IRIGEL(4,IRI)                                                   
         COER=COERIG(IRI)                                                       
         SEGACT,xMATRI                                                          
         DO 30 I2=1,N2                                                          
*                                                                               
*---        ON REMPLIT LE VECTEUR CONTENANT LA MATRICE LUMPEE                   
*                                                                               
*            XMATRI=IMATTT(I2)                                                   
*            SEGACT,XMATRI                                                       
            DO 33 IN=1,NLIGRE                                                   
               J2=ICPR(NUM(NOELEP(IN),I2))                                      
               J1=MUITRA(IN)                                                    
               RR=ZERO                                                          
               IF (J1.LT.0) THEN                                                
*                  IKO=(IN+1)*IN/2                                               
                  RR=RE(IN,IN,i2)*COER                                               
                  J1=-J1                                                        
               ELSE                                                             
                  DO 34 JN=1,NLIGRE                                             
*                     IF (JN.GT.IN) THEN                                         
*                        IKO=(JN-1)*JN/2+IN                                      
*                        RR=RR+RE(iko)*COER                                      
*                     ELSE                                                       
*                        IKO=(IN-1)*IN/2+JN                                      
                        RR=RR+RE(JN,IN,i2)*COER                                      
*                     ENDIF                                                      
 34                  CONTINUE                                                   
*                 END DO                                                        
               ENDIF                                                            
               IKI=INCPO(J1,J2)                                                 
* ---- ON NE FAIT PLUS DE TEST SUR RR                                           
               VECTBB(IKI)=VECTBB(IKI)+RR                                       
 33            CONTINUE                                                         
*           END DO                                                              
*            SEGDES,XMATRI                                                       
 30         CONTINUE                                                            
*        END DO                                                                 
         SEGDES,xMATRI,DESCR,MELEME                                             
         SEGSUP,MUITRA                                                          
 20      CONTINUE                                                               
*     END DO                                                                    
*                                                                               
*---  INVERSION DE LA MATRICE LUMPEE                                            
*                                                                               
      LIV=VECTBB(/1)                                                            
      DO 100 IV=1,LIV                                                           
         VECTBB(IV)=UN/VECTBB(IV)                                               
 100     CONTINUE                                                               
*     END DO                                                                    
      SEGDES,MRIGID                                                       
*                                                                               
      END