C DYNE03    SOURCE    CHAT      09/10/09    21:17:32     6519           
      SUBROUTINE DYNE03(IRIGK,IRSCPR,MUCT,ICHOLX)                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
************************************************************************        
*                                                                               
*                             D Y N E 0 3                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*     UTILITAIRE DE L'OPERATEUR "DYNE"                                          
*     PREPARATION DU PRODUIT DE TYPE : K * U                                    
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
* -----------                                                                   
*                                                                               
*     IRIGK   (E)  POINTEUR SUR L'OBJET RIGIDITE K                              
*     IRSCPR  (E)  POINTEUR SUR LE SEGMENT ICPR ( ACTIF )                       
*     MUCT    (S)  POINTEUR SUR LE SEGMENT MUCTRA ( LAISSE ACTIF )              
*     ICHOLX  (E)  POINTEUR SUR LE SEGMENT MMATRI ( ACTIF )                     
*                                                                               
* 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                                                                    
*                                                                               
      CHARACTER*4 NI                                                            
*                                                                               
      SEGMENT MUCTRA                                                            
         REAL*8  CC(NLIGMA)                                                     
         INTEGER MUCPO,MUCMIK,MUCDUA,MUIPOS(NLIGMA),MUCPR                       
      ENDSEGMENT                                                                
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
*                                                                               
      MMATRI=ICHOLX                                                             
      MRIGID=IRIGK                                                              
      SEGACT,MRIGID                                                             
      NRIGEL=IRIGEL(/2)                                                         
      NLIGMA=0                                                                  
*                                                                               
*---  ON VERIFIE QUE LES DDL DES RIGIDITES K ET A SONT COMPATIBLES              
*                                                                               
      MINCPO=IINCPO                                                             
      MIMIK=IIMIK                                                               
      ICPR=IRSCPR                                                               
      ININC=IMIK(/2)                                                            
*                                                                               
*---  BOUCLE SUR LES ZONES ELEMENTAIRES DE LA RIGIDITE                          
*                                                                               
      DO 20 IRI=1,NRIGEL                                                        
         MELEME=IRIGEL(1,IRI)                                                   
         SEGACT,MELEME                                                          
         DESCR=IRIGEL(3,IRI)                                                    
         SEGACT,DESCR                                                           
         NLIGRE=LISINC(/2)                                                      
         IF (NLIGRE.GT.NLIGMA) NLIGMA=NLIGRE                                    
*                                                                               
*---     BOUCLE SUR LES LIGNES D'UNE MATRICE ELEMENTAIRE                        
*                                                                               
         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                                                              
*---        UNE COMPOSANTE DE K N'EST PAS UNE COMPOSANTE DE M                   
            MOTERR(1:4)=' K'                                                    
            MOTERR(5:8)=NI                                                      
            CALL ERREUR(304)                                                    
            RETURN                                                              
 23         CONTINUE                                                            
 21         CONTINUE                                                            
*        END DO                                                                 
*                                                                               
*---     BOUCLE SUR TOUS LES ELEMENTS                                           
*                                                                               
         N1=NUM(/1)                                                             
         N2=NUM(/2)                                                             
         xMATRI=IRIGEL(4,IRI)                                                   
         SEGACT xMATRI                                                          
         DO 30 I2=1,N2                                                          
*                                                                               
*---        BOUCLE SUR LES POINTS DE L'ELEMENT                                  
*                                                                               
            DO 31 I1=1,N1                                                       
               IF(ICPR(NUM(I1,I2)).EQ.0) THEN                                   
*---           UN POINT DU SUPPORT DE K N'APPARTIENT PAS AU SUPPORT DE M        
               INTERR(1)=ICPR(NUM(I1,I2))                                       
               MOTERR(1:4)=' K'                                                 
               CALL ERREUR(305)                                                 
               RETURN                                                           
               ENDIF                                                            
 31            CONTINUE                                                         
*           END DO                                                              
*            XMATRI=IMATTT(I2)                                                   
*            SEGACT,XMATRI                                                       
*                                                                               
 30         CONTINUE                                                            
*        END DO                                                                 
*        SEGDES,DESCR                                                           
*        SEGDES,MELEME                                                          
 20      CONTINUE                                                               
*     END DO                                                                    
*     SEGDES,MRIGID                                                             
*                                                                               
*---  CREATION DU SEGMENT DE TRAVAIL MUCTRA                                     
*                                                                               
      SEGINI,MUCTRA                                                             
      MUCPO=IINCPO                                                              
      MUCMIK=IIMIK                                                              
      MUCDUA=IIDUA                                                              
      MUCPR=IRSCPR                                                              
      MUCT=MUCTRA                                                               
*                                                                               
      END