C MUCHPO SOURCE CB215821 20/11/25 13:34:37 10792 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 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