C VARCHE    SOURCE    PV        09/03/12    21:36:12     6325           
      SUBROUTINE VARCHE(IPCHE1,IPEVOL,IPCHMU,IRET)                              
*___________________________________________________________________            
*                                                                               
*         MULTIPLICATION D'UN MCHAML PAR UN OBJET EVOLUTION                     
*                (APPELE PAR OPERMU)                                            
*                                                                               
*  ENTREES :                                                                    
*  _________                                                                    
*                                                                               
*     IPCHE1   POINTEUR SUR UN CHAMELEM (TYPE MCHAML)                           
*     IPEVOL   POINTEUR SUR UN OBJET EVOLUTION                                  
*                                                                               
*                                                                               
*  SORTIE :                                                                     
*  ________                                                                     
*                                                                               
*     IPCHMU   POINTEUR SUR UN CHAMELEM RESULTAT (TYPE MCHAML)                  
*     IRET     =0 SI L'OPERATION EST IMPOSSIBLE.                                
*                                                                               
*  PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12/90                       
*                                                                               
*___________________________________________________________________            
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*                                                                               
-INC CCOPTIO                                                                    
-INC SMCHAML                                                                    
-INC SMLREEL                                                                    
-INC SMEVOLL                                                                    
-INC SMCOORD                                                                    
*                                                                               
      IRET=1                                                                    
      KERRE=0                                                                   
      YTT1=0.D0                                                                 
*                                                                               
*  ON RECUPERE L'OBJET EVOLUTION                                                
*                                                                               
      MEVOLL=IPEVOL                                                             
      SEGACT MEVOLL                                                             
      KEVOLL=IEVOLL(1)                                                          
      SEGACT KEVOLL                                                             
      MLREEL=IPROGX                                                             
      MLREE1=IPROGY                                                             
      SEGDES KEVOLL,MEVOLL                                                      
      SEGACT MLREEL,MLREE1                                                      
      NBPOIX=PROG(/1)                                                           
      NBPOIY=MLREE1.PROG(/1)                                                    
*                                                                               
*     ACTIVATION DU CHAMELEM                                                    
*                                                                               
      MCHELM=IPCHE1                                                             
      SEGINI,MCHEL1=MCHELM                                                      
      IPCHMU=MCHEL1                                                             
*                                                                               
*     BOUCLE SUR LES SOUS ZONE                                                  
*                                                                               
      DO 100 ISOUS=1,MCHEL1.ICHAML(/1)                                          
         MCHAML=MCHEL1.ICHAML(ISOUS)                                            
         SEGINI,MCHAM1=MCHAML                                                   
         MCHEL1.ICHAML(ISOUS)=MCHAM1                                            
*                                                                               
         DO 200 ICOMP=1,MCHAM1.IELVAL(/1)                                       
            MELVAL=MCHAM1.IELVAL(ICOMP)                                         
            SEGINI,MELVA1=MELVAL                                                
            N1PTEL=MELVA1.VELCHE(/1)                                            
            IF (N1PTEL.EQ.0) THEN                                               
               N2PTEL=MELVA1.IELCHE(/1)                                         
               N2EL  =MELVA1.IELCHE(/2)                                         
               IF (MCHAM1.TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN             
                  DO 201 IGAU=1,N2PTEL                                          
                     DO 201 IB=1,N2EL                                           
                        MLREE2=MELVA1.IELCHE(IGAU,IB)                           
                        SEGACT MLREE2                                           
                        JG=MLREE2.PROG(/1)                                      
                        SEGINI MLREE3                                           
                        DO 202 IPROG=1,JG                                       
                           XTT1=MLREE2.PROG(IPROG)                              
             CALL VARIFO(MLREEL.PROG,MLREE1.PROG,NBPOIX,XTT1,YTT1,KERRE)        
                           IF (KERRE.EQ.211) THEN                               
                              CALL ERREUR (211)                                 
                              SEGDES MLREEL,MLREE1,MLREE2                       
                              SEGSUP MELVA1,MCHAM1,MCHEL1                       
                              IRET=0                                            
                              RETURN                                            
                           ENDIF                                                
                           MLREE3.PROG(IPROG)=YTT1                              
 202                    CONTINUE                                                
                        MELVA1.IELCHE(IGAU,IB)=MLREE3                           
                        SEGDES MLREE3,MLREE2                                    
 201              CONTINUE                                                      
               ELSE IF (MCHAM1.TYPCHE(ICOMP).EQ.'POINTEURPOINT   ') THEN        
                  DO 203 IGAU=1,N2PTEL                                          
                     DO 203 IB=1,N2EL                                           
                        IP=MELVA1.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 204 IC=1,IDIM                                        
                           XTT1=XCOOR(IREF+IC)                                  
             CALL VARIFO(MLREEL.PROG,MLREE1.PROG,NBPOIX,XTT1,YTT1,KERRE)        
                           IF (KERRE.EQ.211) THEN                               
                              CALL ERREUR (211)                                 
                              SEGDES MLREEL,MLREE1,MLREE2                       
                              SEGSUP MELVA1,MCHAM1,MCHEL1                       
                              IRET=0                                            
                              RETURN                                            
                           ENDIF                                                
                           XCOOR(NBNOI*(IDIM+1)+IC)=XTT1*YTT1                   
 204                    CONTINUE                                                
                     XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))        
                        IELCHE(IGAU,IB)=NBPTS                                   
 203              CONTINUE                                                      
                                                                                
               ELSE                                                             
*                                                                               
*                 NOM DE COMPOSANTE NON RECONNU                                 
*                                                                               
                  MOTERR(1:4)=MCHAM1.NOMCHE(ICOMP)                              
                  CALL ERREUR (197)                                             
                  SEGSUP MELVA1,MCHAM1,MCHEL1                                   
                  RETURN                                                        
               ENDIF                                                            
            ELSE                                                                
               N1EL=MELVA1.VELCHE(/2)                                           
               DO 300 IGAU=1,N1PTEL                                             
                  DO 300 IB=1,N1EL                                              
                     XTT1 = MELVA1.VELCHE(IGAU,IB)                              
             CALL VARIFO(MLREEL.PROG,MLREE1.PROG,NBPOIX,XTT1,YTT1,KERRE)        
                     IF(KERRE.EQ.211)THEN                                       
                        CALL ERREUR (211)                                       
                        SEGDES MLREEL,MLREE1                                    
                        SEGSUP MELVA1,MCHAM1,MCHEL1                             
                        IRET=0                                                  
                     ENDIF                                                      
                     MELVA1.VELCHE(IGAU,IB)=YTT1                                
 300           CONTINUE                                                         
            ENDIF                                                               
            MCHAM1.IELVAL(ICOMP)=MELVA1                                         
            SEGDES MELVA1                                                       
 200     CONTINUE                                                               
         SEGDES MCHAM1                                                          
 100  CONTINUE                                                                  
      SEGDES MCHEL1                                                             
*                                                                               
      SEGDES MLREEL,MLREE1                                                      
      RETURN                                                                    
      END