C DYNE07    SOURCE    CHAT      05/01/12    23:13:01     5004           
      SUBROUTINE DYNE07(ICHT2,MMATRX,IPCREF,IPCHPO)                             
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
************************************************************************        
*                                                                               
*                             D Y N E 0 7                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*     UTILITAIRE DE L'OPERATEUR "DYNE"                                          
*     MET LES VALEURS D'UN VECTEUR ORDONNE SELON L'OBJET RIGIDITE M             
*     DANS UN CHPOINT, ORDONNE SELON UN AUTRE CHPOINT DE REFERENCE.             
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
* -----------                                                                   
*                                                                               
*     VEC     (E)  VECTEUR                                                      
*     MMATRX  (E)  POINTEUR SUR LE SEGMENT MMATRI ( ACTIF )                     
*     IPCREF  (E)  POINTEUR SUR LE CHPOINT DE REFERENCE                         
*     IPCHPO  (S)  POINTEUR SUR LE CHPOINT RESULTAT                             
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*     DENIS ROBERT, LE 6 DECEMBRE 1988.                                         
*     REVU ET CORRIGE DECEMBRE 89 MP                                            
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
* MODULES UTILISES:                                                             
*                                                                               
-INC SMCHPOI                                                                    
-INC SMMATRI                                                                    
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
*                                                                               
      SEGMENT,MCHT2                                                             
         REAL*8 VCC2(NDDL)                                                      
      ENDSEGMENT                                                                
*                                                                               
*     REAL*8 VEC(*)                                                             
*                                                                               
      SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))                                          
      SEGMENT,ICOR(NC1)                                                         
*                                                                               
*---  ACTIVATION DES SEGMENTS                                                   
*                                                                               
      MCHT2=ICHT2                                                               
      MMATRI=MMATRX                                                             
      MCHPO1=IPCREF                                                             
      SEGACT,MCHPO1                                                             
      NSOUP1=MCHPO1.IPCHP(/1)                                                   
      MELEME=IGEOMA                                                             
      MIMIK=IIMIK                                                               
      IMI=IMIK(/2)                                                              
      MHARK=IHARK                                                               
      MINCPO=IINCPO                                                             
      N2=NUM(/2)                                                                
*                                                                               
*---  RECENSEMENT DES POINTS SUPPORTS                                           
*                                                                               
      SEGINI,ICPR                                                               
      DO 10 I=1,N2                                                              
         ICPR(NUM(1,I))=I                                                       
 10      CONTINUE                                                               
*     END DO                                                                    
*                                                                               
*---  INITIALISATION DU CHPOINT RESULTAT                                        
*                                                                               
      NSOUPO=NSOUP1   
      NAT=1                                                          
      SEGINI,MCHPOI                                                             
      IPCHPO=MCHPOI                                                             
      MTYPOI='SCALAIRE'                                                         
      MOCHDE=' '  
      JATTRI(1)=MCHPO1.JATTRI(1)                                                              
      IFOPOI=IFOUR                                                              
*                                                                               
*---  BOUCLE SUR LES PARTITIONS DU CHPOINT DE REFERENCE                         
*                                                                               
      DO 100 I=1,NSOUP1                                                         
         MSOUP1=MCHPO1.IPCHP(I)                                                 
         SEGACT,MSOUP1                                                          
         IPT1=MSOUP1.IGEOC                                                      
         SEGACT,IPT1                                                            
         SEGINI,IPT2=IPT1                                                       
         NC=MSOUP1.NOCOMP(/2)                                                   
         SEGINI,MSOUPO                                                          
         IPCHP(I)=MSOUPO                                                        
         IGEOC=IPT2                                                             
         NC1=NC                                                                 
         SEGINI,ICOR                                                            
         DO 110 KI=1,NC                                                         
            NOCOMP(KI)=MSOUP1.NOCOMP(KI)                                        
            NOHARM(KI)=MSOUP1.NOHARM(KI)                                        
            DO 120 J=1,IMI                                                      
               IF (MSOUP1.NOCOMP(KI).NE.IMIK(J)) GO TO 120                      
               IF (MSOUP1.NOHARM(KI).NE.IHAR(J)) GO TO 120                      
               ICOR(KI)=J                                                       
               GO TO 110                                                        
 120           CONTINUE                                                         
*           END DO                                                              
 110        CONTINUE                                                            
*        END DO                                                                 
         MPOVA1=MSOUP1.IPOVAL                                                   
         SEGACT,MPOVA1                                                          
         N=MPOVA1.VPOCHA(/1)                                                    
         SEGINI,MPOVAL=MPOVA1                                                   
         IPOVAL=MPOVAL                                                          
         DO 200 J=1,N                                                           
            K=ICPR(IPT1.NUM(1,J))                                               
            IF (K.NE.0) GO TO 300                                               
*                                                                               
*---        INCOMPATIBILITE D'UN POINT SUPPORT                                  
*                                                                               
            CALL ERREUR(252)                                                    
            RETURN                                                              
 300        CONTINUE                                                            
            DO 200 LI=1,NC                                                      
               KKIL=ICOR(LI)                                                    
               IF (KKIL.EQ.0) GO TO 200                                         
               KI=INCPO(KKIL,K)                                                 
               IF (KI.NE.0) GO TO 400                                           
*                                                                               
*---           INCOMPATIBILITE DE TYPE D'INCONNUE                               
*                                                                               
               CALL ERREUR(288)                                                 
*              RETURN                                                           
 400           CONTINUE                                                         
               VPOCHA(J,LI)=VCC2(KI)                                            
 200        CONTINUE                                                            
*        END DO                                                                 
         SEGDES,MPOVA1,MSOUP1,IPT1                            
         SEGDES,MPOVAL,MSOUPO,IPT2                                              
         SEGSUP,ICOR                                                            
 100     CONTINUE                                                               
*     END DO                                                                    
      SEGSUP,ICPR                                                               
      SEGDES,MCHPO1,MCHPOI                                                
*                                                                               
      END