C MUCHPO    SOURCE    CB215821  25/04/23    21:15:30     12247          
      SUBROUTINE MUCHPO(IPO1,XFLOT,IRET,IEPS)
C=======================================================================
C
C     MULTIPLIE UN CHPS PAR POINT PAR XFLO  SI IEPS=1
C     MULTIPLIE UN CHPS PAR POINT PAR 1/XFLO SI IEPS=-1
C     LE CHPS RESULTANT VOIT SON POINTEUR STOCKE DANS IRET
C     SI L OPERATION N EST PAS POSSIBLE IRET=0
C        PAR EXAMPLE SI IEPS=-1 ET XFLOT=0.
C  ENTREES
C     IPO1=POINTEUR SUR LE CHAMPOINT
C     XFLOT=SCALAIRE
C     IEPS=1 SI MULTIPLICATION -1 SI DIVISION
C  SORTIES
C     IRET=POINTEUR SUR LE CHAMPS*XFLOT**IEPS
C         =0 SI L OPERATION EST IMPOSSSIBLE
C
C     CODE EBERSOLT JUIN 84
C     ATTENTION LES CHAMPS PAR ELEMENTS SONT EN DOUBLE PRECISION
C     SI ON VOULAIT PASSER EN SIMPLE IL FAUT CHANGER VELCHA EN VELCHD
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC SMCHPOI
-INC SMCOORD
-INC PPARAM
-INC CCOPTIO
      IRET=0
      IF(IEPS.EQ.-1.AND.XFLOT.EQ.0.) GOTO 666
      IF(IEPS.EQ.1)  XFLOT1=XFLOT
      IF(IEPS.EQ.-1) XFLOT1=1.D0/XFLOT
      MCHPO1=IPO1
      SEGACT MCHPO1
      NSOUPO=MCHPO1.IPCHP(/1)
      NAT=MCHPO1.JATTRI(/1)
      SEGINI MCHPOI
      IRET=MCHPOI
      MTYPOI=MCHPO1.MTYPOI
      IFOPOI   =MCHPO1.IFOPOI
      MOCHDE=MCHPO1.MOCHDE
      DO 50 IN = 1,NAT
      JATTRI(IN) = MCHPO1.JATTRI(IN)
  50  CONTINUE
*
      DO 72 IA=1,NSOUPO
        MSOUP1=MCHPO1.IPCHP(IA)
        SEGACT MSOUP1
        NC=MSOUP1.NOCOMP(/2)
        SEGINI MSOUPO
        IPCHP(IA)=MSOUPO
        IGEOC=MSOUP1.IGEOC
*
        DO 73 IB=1,NC
          NOCOMP(IB)=MSOUP1.NOCOMP(IB)
          NOHARM(IB)=MSOUP1.NOHARM(IB)
  73    CONTINUE
*
        MPOVA1=MSOUP1.IPOVAL
        SEGACT MPOVA1
        N=MPOVA1.VPOCHA(/1)
        NC=MPOVA1.VPOCHA(/2)
        SEGINI MPOVAL
        IPOVAL=MPOVAL
*
        DO 75 IB=1,N
          DO 76 IC=1,NC
             VPOCHA(IB,IC)=XFLOT1*MPOVA1.VPOCHA(IB,IC)
  76      CONTINUE
  75    CONTINUE
*
  72  CONTINUE
  666 CONTINUE
      END