C DYNE00    SOURCE    CHAT      09/10/09    21:17:27     6519           
      SUBROUTINE DYNE00(IPRIGM,IRSCPR,ICHOLX,LONVEC)                            
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
************************************************************************        
*                                                                               
*                             D Y N E 0 0                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*     UTILITAIRE DE L'OPERATEUR "DYNE"                                          
*     ASSEMBLAGE EVENTUEL DE LA MATRICE MASSE ET CREATION DE ICPR               
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
* -----------                                                                   
*                                                                               
*     IPRIGM  (E)  POINTEUR SUR L'OBJET RIGIDITE M ( LAISSE ACTIF )             
*     IRSCPR  (S)  POINTEUR SUR LE SEGMENT ICPR ( LAISSE ACTIF )                
*     ICHOLX  (S)  POINTEUR SUR LE SEGMENT MMATRI ( LAISSE ACTIF )              
*     LONVEC  (S)  NOMBRE DE NOEUDS                                             
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*     DENIS ROBERT, LE 16 NOVEMBRE 1988.                                        
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
* MODULES UTILISES:                                                             
*                                                                               
-INC CCOPTIO                                                                    
-INC SMRIGID                                                                    
-INC SMELEME                                                                    
-INC SMMATRI                                                                    
-INC SMCOORD                                                                    
*                                                                               
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
*                                                                               
      MRIGID=IPRIGM                                                             
      SEGACT,MRIGID                                                             
      IF (ICHOLE.EQ.0) THEN                                                     
*                                                                               
*---     ASSEMBLAGE DE M                                                        
*                                                                               
         CALL ASSEM1(IPRIGM,MMATRX,INUINX,ITOPOX,IMINIX,IPOX,INCTRX             
     *   ,LL)                                                                   
         CALL ASSEM2(IPRIGM,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX             
     *   ,LL)                                                                   
         IF(IERR.NE.0) RETURN                                                   
         MRIGID=IPRIGM                                                          
         SEGACT,MRIGID                                                          
         ICHOLE=MMATRX                                                          
      ENDIF                                                                     
      ICHOLX=ICHOLE                                                             
*                                                                               
      MMATRI=ICHOLX                                                             
      SEGACT,MMATRI                                                             
      MELEME=IGEOMA                                                             
*                                                                               
*---  FABRICATION DE ICPR                                                       
*                                                                               
      SEGACT,MCOORD                                                             
      SEGINI,ICPR                                                               
      LX=ICPR(/1)                                                               
      DO 2 I=1,LX                                                               
         ICPR(I)=0                                                              
 2       CONTINUE                                                               
*     END DO                                                                    
      SEGACT,MELEME                                                             
      N1=NUM(/1)                                                                
      N2=NUM(/2)                                                                
      IK=0                                                                      
      DO 3 I1=1,N1                                                              
      DO 3 I2=1,N2                                                              
         K=NUM(I1,I2)                                                           
         IF(ICPR(K).NE.0) GOTO 3                                                
         IK=IK+1                                                                
         ICPR(K)=IK                                                             
 3       CONTINUE                                                               
*     END DO                                                                    
*                                                                               
      MILIGN=IILIGN                                                             
      SEGACT,MILIGN                                                             
      LONVEC=IPNO(/1)                                                           
      SEGDES,MILIGN                                                             
*                                                                               
      IRSCPR=ICPR                                                               
*                                                                               
      END