C PUCHEL    SOURCE    BP208322  10/12/15    21:15:29     6813           
      SUBROUTINE PUCHEL(IPCHE1,IPU,IPCHPU,IRET)                                 
*_______________________________________________________________________        
*                                                                               
*           ELEVATION A UNE PUISSANCE ENTIERE D'UN CHAMELEM                     
*                                                                               
*  ENTREES :                                                                    
*  ---------                                                                    
*                                                                               
*     IPCHE1   POINTEUR SUR LE CHAMPS PAR ELEMENT A ELEVER A LA PUISSANC        
*              IPU                                                              
*     IPU      PUISSANCE ( C EST UN ENTIER POSITIF OU NEGATIF )                 
*                                                                               
*                                                                               
*  SORTIES :                                                                    
*  ---------                                                                    
*                                                                               
*     IPCHPU   POINTEUR SUR LE CHAMELEM RESULTANT                               
*     IRET=1                                                                    
*         =0  SI OPERATION IMPOSSSIBLE                                          
*                                                                               
*     CODE EBERSOLT AVRIL 85                                                    
*                                                                               
*     PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12/90                    
*                                                                               
*_______________________________________________________________________        
*                                                                               
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER(I-N)
-INC SMCHAML                                                                    
-INC CCOPTIO                                                                    
-INC SMLREEL                                                                    
-INC SMEVOLL
*                                                                               
      IRET=1                                                                    
      MCHEL1=IPCHE1                                                             
*                                                                               
*     INITIALISATION DU CHAPEAU DU SEGMENT                                      
*                                                                               
      SEGINI,MCHELM=MCHEL1                                                      
      IPCHPU=MCHELM                                                             
*                                                                               
*     BOUCLE SUR LES SOUS ZONES                                                 
*                                                                               
      DO 30 ISOUS=1,ICHAML(/1)                                                  
         MCHAM1=ICHAML(ISOUS)                                                   
         SEGINI,MCHAML=MCHAM1                                                   
         ICHAML(ISOUS)=MCHAML                                                   
         DO 40 ICOMP=1,IELVAL(/1)                                               
            MELVA1=IELVAL(ICOMP)                                                
            SEGINI,MELVAL=MELVA1                                                
            IELVAL(ICOMP)=MELVAL                                                
            IF (TYPCHE(ICOMP).EQ.'REAL*8') THEN                                 
               N1PTEL=VELCHE(/1)                                                
               N1EL  =VELCHE(/2)                                                
               DO 20 IGAU=1,N1PTEL                                              
                  DO 20 IB=1,N1EL                                               
                     XTRA=VELCHE(IGAU,IB)                                       
                     VELCHE(IGAU,IB)=XTRA ** IPU                                
 20            CONTINUE                                                         
            ELSE IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN                  
               N2PTEL=IELCHE(/1)                                                
               N2EL  =IELCHE(/2)                                                
               DO 10 IGAU=1,N2PTEL                                              
                  DO 10 IB=1,N2EL                                               
                     MLREE1=IELCHE(IGAU,IB)                                     
                     SEGACT MLREE1                                              
                     JG=MLREE1.PROG(/1)                                         
                     SEGINI MLREEL                                              
                     DO 11 IPROG=1,JG                                           
                        XTRA=MLREE1.PROG(IPROG)                                 
                        PROG(IPROG)=XTRA ** IPU                                 
 11                  CONTINUE                                                   
                     IELCHE(IGAU,IB)=MLREEL                                     
                     SEGDES MLREE1,MLREEL                                       
 10            CONTINUE                                                         
            ELSE IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') THEN
               N2PTEL=IELCHE(/1)
               N2EL  =IELCHE(/2)
               DO 12 IGAU=1,N2PTEL
                  DO 12 IB=1,N2EL
                     MEVOL1=IELCHE(IGAU,IB)
c                      XFLO=REAL(IPU)
                     IRET=1
                     CALL PUEVOL(MEVOL1,0.D0,IPU,MEVOL2,IRET)
                     IELCHE(IGAU,IB)=MEVOL2
 12            CONTINUE
            ELSE                                                                
*                                                                               
*              NOM DE COMPOSANTE NON RECONNU                                    
*                                                                               
               MOTERR(1:4)='**  '                                               
               MOTERR(5:8)=NOMCHE(ICOMP)                                        
               CALL ERREUR(335)                                                 
               SEGSUP MELVAL,MCHAML,MCHELM                                      
               IPCHPU=0                                                         
               RETURN                                                           
            ENDIF                                                               
            SEGDES MELVAL                                                       
 40     CONTINUE                                                                
        SEGDES MCHAML                                                           
 30   CONTINUE                                                                  
      SEGDES MCHELM                                                             
      RETURN                                                                    
      END