C TRACHP    SOURCE    CHAT      05/01/13    03:44:18     5004           
      SUBROUTINE TRACHP(MCHPOI,MTRAV)                                           
*                                                                               
*   MET UN CHAMP POINT SOUS FORME DE TRAVAIL                                    
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC SMCOORD                                                                    
-INC CCOPTIO                                                                    
-INC SMCHPOI                                                                    
-INC SMELEME                                                                    
-INC TMTRAV                                                                     
      SEGMENT ITRAV                                                             
          CHARACTER*4 INC(NN)                                                   
          INTEGER  IHAR(NN)                                                     
      ENDSEGMENT                                                                
      NN = 0                                                                    
      SEGACT MCHPOI                                                             
*                                                                               
*  ON ACTIVE TOUS LES SEGMENTS  MSOUPO                                          
*                                                                               
      DO 1 I=1,IPCHP(/1)                                                        
      MSOUPO=IPCHP(I)                                                           
      SEGACT MSOUPO                                                             
      NN = NN + NOCOMP(/2)                                                      
   1  CONTINUE                                                                  
*                                                                               
*    CREATION DE ITRAV ET REMPLISSAGE                                           
*                                                                               
      NNNOE=0                                                                   
      SEGINI ITRAV                                                              
      NNIN=0                                                                    
      DO 2 I=1,IPCHP(/1)                                                        
      MSOUPO=IPCHP(I)                                                           
      DO 3 J=1,NOCOMP(/2)                                                       
      DO 4 K=1,NNIN                                                             
      IF(INC(K).NE.NOCOMP(J)) GO TO 4                                           
      IF(IHAR(K).EQ.NOHARM(J)) GO TO 3                                          
    4 CONTINUE                                                                  
      NNIN=NNIN+1                                                               
      INC(NNIN)=NOCOMP(J)                                                       
      IHAR(NNIN)=NOHARM(J)                                                      
   3  CONTINUE                                                                  
      MELEME=IGEOC                                                              
      SEGACT MELEME                                                             
      NNNOE=NNNOE+NUM(/2)                                                       
   2  CONTINUE                                                                  
*                                                                               
*   CREATION DE MTRAV ET REMPLISSAGE                                            
*                                                                               
      NDEJ=0                                                                    
      SEGINI MTRAV                                                              
      DO 7 I=1,IPCHP(/1)                                                        
      MSOUPO=IPCHP(I)                                                           
      MPOVAL=IPOVAL                                                             
      SEGACT MPOVAL                                                             
      DO 8 J=1,NOCOMP(/2)                                                       
      DO 9 K=1,NNIN                                                             
      IF(NOCOMP(J).NE.INC(K)) GO TO 9                                           
      IF(NOHARM(J).EQ.IHAR(K)) GO TO 10                                         
   9  CONTINUE                                                                  
      CALL ERREUR (5)                                                           
  10  CONTINUE                                                                  
      KK=K                                                                      
      MELEME=IGEOC                                                              
      DO 11 K=1,NUM(/2)                                                         
      BB(KK,K+NDEJ)=VPOCHA(K,J)                                                 
      IBIN(KK,K+NDEJ)=1                                                         
      IGEO(K+NDEJ)=NUM(1,K)                                                     
  11  CONTINUE                                                                  
   8  CONTINUE                                                                  
      NDEJ=NDEJ+NUM(/2)                                                         
      SEGDES MELEME                                                       
      SEGDES MPOVAL                                                       
      SEGDES MSOUPO                                                       
   7  CONTINUE                                                                  
      SEGDES MCHPOI                                                             
      DO 13 I=1,NNIN                                                            
      INCO(I)=INC(I)                                                            
      NHAR(I)=IHAR(I)                                                           
  13  CONTINUE                                                                  
*     WRITE(6,30) (INCO(I),I=1,NNIN)                                            
*     WRITE(6,31) (NHAR(I),I=1,NNIN)                                            
*     WRITE(6,32) (( IBIN(I,J),I=1,NNIN),J=1,NNNOE)                             
*     WRITE(6,33) (( BB(I,J),I=1,NNIN),J=1,NNNOE)                               
*     WRITE(6,36) ( IGEO(I),I=1,NNNOE)                                          
* 36  FORMAT('  IGEO ', /,(20I4))                                               
* 30  FORMAT('  INCO ', 6A6)                                                    
* 31  FORMAT('  NHAR ', 6I6)                                                    
* 32  FORMAT('  IBIN  ',/,(20I4))                                               
* 33  FORMAT('  BB    ',/,(1X,6E12.5))                                          
      SEGDES MTRAV                                                              
      SEGSUP ITRAV                                                              
      RETURN                                                                    
      END