C VARCHP    SOURCE    OF166741  25/02/20    21:17:57     12165          

C----------------------------------------------------------------
C  ENTREES:
C     IPOI1=POINTEUR SUR UN CHPOINT
C     IPOI2=POINTEUR SUR UN EVOLUTION
C  SORTIE:
C     IPOI3=POINTEUR SUR LE CHPOINT RESULTAT
C     IRET = 1 SI SUCCES 0 SINON
C----------------------------------------------------------------

      SUBROUTINE VARCHP (IPOI1,IPOI2,IPOI3,IRET)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)


-INC PPARAM
-INC CCOPTIO

-INC SMEVOLL
-INC SMCHPOI
-INC SMLREEL

      IRET  = 0
      IPOI3 = 0
C
C  ON RECUPERE L'OBJET EVOLUTION
C
      MEVOLL = IPOI2
      SEGACT,MEVOLL
      KEVOLL = mevoll.IEVOLL(1)
      SEGDES,MEVOLL
      SEGACT,KEVOLL
      IF (kevoll.TYPX .NE. 'LISTREEL' .OR.
     &    kevoll.TYPY .NE. 'LISTREEL') THEN
        SEGDES,KEVOLL
        MOTERR(1:8) = 'LISTREEL'
        CALL ERREUR(37)
        RETURN
      ENDIF
      MLREE1 = kevoll.IPROGX
      MLREE2 = kevoll.IPROGY
      SEGDES,KEVOLL

      SEGACT,MLREE1,MLREE2
      NBPOIX = MLREE1.PROG(/1)
      NBPOIY = MLREE2.PROG(/1)
* Petites verifications sur le contenu de l'evolution
      IF (NBPOIX.NE.NBPOIY) THEN
        CALL ERREUR(577)
        GOTO 999
      ENDIF
      JORDO = 0
      CALL VARIFV(MLREE1.PROG,NBPOIX,JORDO)
      IF (JORDO.EQ.0) THEN
        CALL ERREUR(872)
        GOTO 999
      ENDIF
C
C  ON RECUPERE LE CHPOINT
C
      MCHPO1 = IPOI1
      SEGINI,MCHPOI=MCHPO1
      NSOUPO = MCHPOI.IPCHP(/1)
C
C     BOUCLE SUR LES SOUS PAQUETS
C
      DO 100 IA = 1, NSOUPO

        MSOUP1 = MCHPOI.IPCHP(IA)
        SEGINI,MSOUPO=MSOUP1
        MCHPOI.IPCHP(IA) = MSOUPO
        MPOVA1 = MSOUPO.IPOVAL
        SEGACT,MPOVA1
        N  = MPOVA1.VPOCHA(/1)
        NC = MPOVA1.VPOCHA(/2)
        SEGINI,MPOVAL
        MSOUPO.IPOVAL = MPOVAL
        DO 200 IC = 1,NC
          DO 200 IB = 1, N
            XTT1 = MPOVA1.VPOCHA(IB,IC)
            CALL VARIFO(MLREE1.PROG,MLREE2.PROG,NBPOIX,JORDO,XTT1,YTT1)
            MPOVAL.VPOCHA(IB,IC) = YTT1
 200    CONTINUE
        SEGDES,MPOVA1,MPOVAL,MSOUPO

 100  CONTINUE

      SEGDES,MCHPOI

      IRET  = 1
      IPOI3 = MCHPOI

 999  CONTINUE
      SEGDES MLREE1,MLREE2

      RETURN
      END