C REDUCP    SOURCE    CB215821  20/11/25    13:38:51     10792          
      SUBROUTINE REDUCP (MCHPOI,MCHPO1,IRET)
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC TMTRAV

      REAL*8 EPS
      SEGMENT NOINCO
         CHARACTER*(LOCOMP) INC(NMA)
         INTEGER NHA(NMA)
      ENDSEGMENT
*
* VERIFICATION QUE LES DEUX CHPOINTS ONT EXACTEMENT LA MEME STRUCTURE
*
      IF (IPCHP(/1).NE.MCHPO1.IPCHP(/1)) THEN
         CALL ERREUR(21)
         RETURN
      ENDIF
      EPS=1.D-5
      NMA=0
      NNNOE=0
      DO 1 I = 1 , IPCHP(/1)
      MSOUPO=IPCHP(I)
      MSOUP1=MCHPO1.IPCHP(I)
      NMA=NMA+NOCOMP(/2)
      IF(NOCOMP(/2).NE.MSOUP1.NOCOMP(/2)) THEN
         CALL ERREUR(21)
         RETURN
      ENDIF
      DO 2 J=1,NOCOMP(/2)
      IF (NOCOMP(J).EQ.MSOUP1.NOCOMP(J)) THEN
         IF (NOHARM(J).NE.MSOUP1.NOHARM(J)) THEN
            CALL ERREUR (21)
            RETURN
          ENDIF
      ELSE
         CALL ERREUR (21)
         RETURN
      ENDIF
    2 CONTINUE
      MELEME=IGEOC
      IPT1=MSOUP1.IGEOC
      NNNOE=NNNOE+NUM(/2)
      IF(NUM(/2).NE.IPT1.NUM(/2))  THEN
         CALL ERREUR(21)
         RETURN
      ENDIF
   1  CONTINUE
*
*  ON CHERCHE LA DIMENSION DE MTRAV
*
      SEGINI NOINCO
      NNIN=0
      DO 3 I=1,IPCHP(/1)
        MSOUPO=IPCHP(I)
        DO 4 J=1,NOCOMP(/2)
          DO 5 K=1,NNIN
            IF(INC(K).NE.NOCOMP(J)) GOTO 5
            IF(NHA(K).EQ.NOHARM(J)) GOTO 4
    5     CONTINUE
          NNIN=NNIN+1
          INC(NNIN)=NOCOMP(J)
          NHA(NNIN)=NOHARM(J)
    4   CONTINUE
    3 CONTINUE
*
*  CREATION DE MTRAV ET REMPLISSAGE
*
      SEGINI MTRAV
      DO 6 I=1,NNIN
      INCO(I)=INC(I)
      NHAR(I)=NHA(I)
    6 CONTINUE
      NDEJ=0
      DO 7 I=1,IPCHP(/1)
      MSOUPO=IPCHP(I)
      MSOUP1=MCHPO1.IPCHP(I)
      MELEME=IGEOC
      DO 8 J=1,NUM(/2)
      IGEO(J+NDEJ)=NUM(1,J)
   8  CONTINUE
      MPOVAL=IPOVAL
      MPOVA1=MSOUP1.IPOVAL
      DO 9 J=1,NOCOMP(/2)
      DO 10 K=1,NNIN
      IF(INCO(K).EQ.NOCOMP(J)) THEN
         IF(NHAR(K).EQ.NOHARM(J)) THEN
            NHA(J)=K
            GO TO 9
         ENDIF
      ENDIF
  10  CONTINUE
      CALL ERREUR(5)
      RETURN
   9  CONTINUE
      DO 11 J=1,NUM(/2)
      DO 12 K=1,NOCOMP(/2)
      NN=NHA(K)
      IF(ABS(MPOVA1.VPOCHA(J,K)).GT.EPS)  THEN
         BB(NN,NDEJ+J)=VPOCHA(J,K)
         IBIN(NN,NDEJ+J)=1
      ENDIF
   12 CONTINUE
   11 CONTINUE
      NDEJ=NDEJ+NUM(/2)
    7 CONTINUE

      CALL CRECHP(MTRAV,IRET)
*
*    on attribut les memes natures
      MCHPO2 = IRET
      NAT   = MAX(1,JATTRI(/1))
      NSOUPO=MCHPO2.IPCHP(/1)
      SEGADJ MCHPO2
      IF ( JATTRI(/1) .NE. 0) THEN
        DO 13 I=1,NAT
          MCHPO2.JATTRI(I)=JATTRI(I)
 13     CONTINUE
      ENDIF
*
      SEGSUP MTRAV,NOINCO
      END