C INTOP1    SOURCE    CHAT      05/01/13    00:41:27     5004           
C   INTERFACE ENTRE LES LECTURES DE DONNEES D'OPERATIONS ELEMENTAIRES           
C   ET LES PROGRAMMES D'EXECUTIONS                                              
C                                                                               
      SUBROUTINE INTOP1(IP2,IP1)                                                 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
-INC SMCHPOI                                                                    
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
      DIMENSION X(3)                                                           
      SEGMENT ITABEL(2)                                                         
      SEGINI ITABEL                                                             
      ITABEL(1)=IP1                                                          
      ITABEL(2)=IP2                                                          
      SEGINI ICPR                                                               
      DO 1 I=1,ICPR(/1)                                                         
   1  ICPR(I)=0                                                                 
      NBELT=ITABEL(/1)                                                          
      DO 7 IITT=1,NBELT                                                         
      IF (IITT .EQ. 1) THEN 
        IPCH1 = ITABEL(NBELT+1-IITT)
        CALL COPIE2(IPCH1,IPCH) 
        MCHPOI = IPCH 
        SEGACT MCHPOI 
        NSOUPO=IPCHP(/1)                                                   
        DO 9 IC =1,NSOUPO  
          MSOUPO = IPCHP(IC) 
          SEGACT MSOUPO*MOD 
          IF ( NOCOMP(/2) .NE. 1) THEN
              CALL ERREUR (251) 
              SEGSUP MSOUPO
              SEGSUP MCHPOI
              SEGSUP ICPR,ITABEL                                                        
              RETURN                                                     
          ENDIF 
          MELEME = IGEOC
          CALL ADDITI(X,MELEME,NOUV,ICPR)                                           
          IF (IERR.NE.0) THEN
              SEGSUP MSOUPO
              SEGSUP MCHPOI
              SEGSUP ICPR,ITABEL                                                        
              RETURN                                                     
          ENDIF 
          IGEOC = NOUV
          SEGDES MSOUPO 
    9   CONTINUE    
        CALL   ECROBJ('CHPOINT',IPCH)
        SEGDES MCHPOI 
        GOTO 8 
      ENDIF 
      MELEME=ITABEL(NBELT+1-IITT)                                               
      SEGACT MELEME                                                             
      IF (LISOUS(/1).NE.0) GOTO 15                                              
      CALL ADDITI(X,MELEME,NOUV,ICPR)                                           
      IF (IERR.NE.0) RETURN                                                     
      MELEME=NOUV                                                               
      SEGDES MELEME                                                             
 20   CALL ECROBJ('MAILLAGE',MELEME)                                            
      GOTO 8                                                                    
  15  CONTINUE                                                                  
      NBSOUS=LISOUS(/1)                                                         
      NBREF=LISREF(/1)                                                          
      NBNN=0                                                                    
      NBELEM=0                                                                  
      SEGINI IPT1                                                               
      DO 30 I=1,LISOUS(/1)                                                      
      ILIS=LISOUS(I)                                                            
      CALL ADDITI(X,ILIS,NOUV,ICPR)                                             
      IF (IERR.NE.0) RETURN                                                     
      IPT1.LISOUS(I)=NOUV                                                       
  30  CONTINUE                                                                  
      IF (LISREF(/1).EQ.0) GOTO 32                                              
      DO 31 I=1,LISREF(/1)                                                      
      ILIS=LISREF(I)                                                            
      CALL ADDITI(X,ILIS,NOUV,ICPR)                                             
      IF (IERR.NE.0) RETURN                                                     
      IPT1.LISREF(I)=NOUV                                                       
  31  CONTINUE                                                                  
  32  CONTINUE                                                                  
      SEGDES MELEME                                                             
      MELEME=IPT1                                                               
      GOTO 20                                                                   
   8  CONTINUE                                                                  
   7  CONTINUE                                                                  
      SEGSUP ICPR,ITABEL                                                        
      RETURN                                                                    
      END