C INTOP1    SOURCE    CB215821  20/11/25    13:30:23     10792          
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 PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
-INC SMCHPOI
      SEGMENT ICPR(nbpts)
      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



 
 
