C MUCHEL    SOURCE    PV        09/03/12    21:29:08     6325           
      SUBROUTINE MUCHEL(IPCHE1,XFLOT,IPCHMU,IEPS)                               
*_______________________________________________________________________        
*                                                                               
*     MULTIPLIE UN CHPS PAR ELMTS PAR XFLO  SI IEPS=1                           
*     MULTIPLIE UN CHPS PAR ELMTS PAR 1/XFLO SI IEPS=-1                         
*     LE CHPS RESULTANT VOIT SON POINTEUR STOCKE DANS IRET                      
*     SI L OPERATION N EST PAS POSSIBLE IRET=0                                  
*        PAR EXEMPLE SI IEPS=-1 ET XFLOT=0.                                     
*        (APPELE PAR OPERMU)                                                    
*                                                                               
*  ENTREES :                                                                    
*  ---------                                                                    
*                                                                               
*     IPCHE1   POINTEUR SUR LE CHAMPS PAR ELEMENT                               
*     XFLOT    SCALAIRE                                                         
*     IEPS     = 1 SI MULTIPLICATION                                            
*               -1 SI DIVISION                                                  
*                                                                               
*  SORTIES :                                                                    
*  ---------                                                                    
*                                                                               
*     IPCHMU   POINTEUR SUR LE CHAMPS*XFLOT**IEPS                               
*              =0  SI OPERATION IMPOSSSIBLE                                     
*                                                                               
*     CODE EBERSOLT JUIN 84                                                     
*                                                                               
*     PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 29 10 90                 
*                                                                               
*_______________________________________________________________________        
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*                                                                               
-INC SMCHAML                                                                    
-INC CCOPTIO                                                                    
-INC SMCOORD                                                                    
-INC SMLREEL                                                                    
-INC SMEVOLL
*                                                                               
      IPCHMU=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                                          
*                                                                               
      MCHEL1=IPCHE1                                                             
      SEGACT MCHEL1
      SEGINI,MCHELM=MCHEL1                                                      
      SEGDES MCHEL1
      IPCHMU=MCHELM                                                             
*                                                                               
      DO 72 ISOUS=1,ICHAML(/1)                                                  
         MCHAM1=ICHAML(ISOUS)                                                   
         SEGACT MCHAM1
         SEGINI,MCHAML=MCHAM1                                                   
         SEGDES MCHAM1
         ICHAML(ISOUS)=MCHAML                                                   
         DO 73 ICOMP=1,IELVAL(/1)                                               
            MELVA1=IELVAL(ICOMP)                                                
            SEGACT MELVA1
            SEGINI,MELVAL=MELVA1                                                
            SEGDES MELVA1
            IELVAL(ICOMP)=MELVAL                                                
            N1PTEL=VELCHE(/1)                                                   
            IF (N1PTEL.NE.0) THEN                                               
               N1EL  =VELCHE(/2)                                                
               DO 74 IGAU=1,N1PTEL                                              
                  DO 74 IB=1,N1EL                                               
                     VELCHE(IGAU,IB)=XFLOT1*VELCHE(IGAU,IB)                     
  74           CONTINUE                                                         
            ELSE                                                                
               N2PTEL=IELCHE(/1)                                                
               N2EL  =IELCHE(/2)                                                
               IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN                    
                  DO 64 IGAU=1,N2PTEL                                           
                     DO 64 IB=1,N2EL                                            
                        ILREE1=IELCHE(IGAU,IB)                                  
                        CALL MUFLIR(ILREE1,XFLOT1,ILREEL,1)                     
                        IELCHE(IGAU,IB)=ILREEL                                  
 64               CONTINUE                                                      
               ELSE IF (TYPCHE(ICOMP).EQ.'POINTEURPOINT   ') THEN               
                  DO 54 IGAU=1,N2PTEL                                           
                     DO 54 IB=1,N2EL                                            
                        IP=IELCHE(IGAU,IB)                                      
                        IREF=(IP-1)*(IDIM+1)                                    
*                                                                               
*                       ON CREE UN NVX POINTS :NOEUD NBNO+1                     
*                                                                               
                        SEGACT MCOORD                                           
                        NBNO=XCOOR(/1)/(IDIM+1)                                 
                        NBNOI=NBNO                                              
                        NBPTS=NBNO+1                                            
                        SEGADJ MCOORD                                           
*                                                                               
                        DO 55 IC=1,IDIM                                         
                         XCOOR(NBNOI*(IDIM+1)+IC)=XCOOR(IREF+IC)*XFLOT1         
 55                     CONTINUE                                                
                    XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))         
                        IELCHE(IGAU,IB)=NBPTS                                   
 54               CONTINUE                                                      
               ELSE IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') THEN
                  DO 65 IGAU=1,N2PTEL
                     DO 65 IB=1,N2EL
                        IEVOL1=IELCHE(IGAU,IB)
                        CALL MUFLEV(IEVOL1,XFLOT,IEVOL2,IEPS)
                        IELCHE(IGAU,IB)=IEVOL2
 65               CONTINUE
               ELSE                                                             
*                                                                               
*                 NOM DE COMPOSANTE NON RECONNU                                 
*                                                                               
                  MOTERR(1:4)=NOMCHE(ICOMP)                                     
                  CALL ERREUR(197)                                              
                  SEGSUP MELVAL                                                 
                  SEGSUP MCHAML                                                 
                  SEGSUP MCHELM                                                 
                  IPCHMU=0                                                      
                  RETURN                                                        
               ENDIF                                                            
            ENDIF                                                               
            SEGDES MELVAL                                                       
*                                                                               
  73     CONTINUE                                                               
         SEGDES MCHAML                                                          
*                                                                               
  72  CONTINUE                                                                  
      SEGDES MCHELM                                                             
*                                                                               
  666 CONTINUE                                                                  
      RETURN                                                                    
      END