C PUCHPR    SOURCE    BP208322  12/05/24    21:15:04     7378           

      SUBROUTINE PUCHPR(IPO1,XPU,IPO2,IRET)                                     

C=======================================================================        
C                                                                               
C  ENTREES                                                                      
C     IPO1=POINTEUR SUR LE CHAMPOINT                                            
C     XPU =PUISSANCE   ( C EST UN REEL  POSITIF OU NEGATIF )                    
C  SORTIES                                                                      
C     IPO2=CHPOINT A LA PUISSANCE IPU                                           
C     IRET=1                                                                    
C         =0 SI UNE COMPOSANTE EST NEGATIVE                                     
C                                                                               
C     CODE EBERSOLT AVRIL 85                                                    
C                                                                               
C=======================================================================        
      IMPLICIT INTEGER(I-N)                                                     
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C                                                                               
-INC SMCHPOI                                                                    
C                                                                               
      IRET=1                                                                    
C                                                                               
      MCHPO1=IPO1                                                               
*                                                                               
*     INITIALISATION DU CHAPEAU DU SEGMENT                                      
*                                                                               
      SEGINI,MCHPOI=MCHPO1  
      NSOUPO=IPCHP(/1)                                                          
      
C     ON ORIENTE SELON LA VALEUR DE XPU (PERFORMANCES)
      if(XPU.eq.0.5d0) goto 100

      
c----------------------------------------------------------------------
c     Cas général Y**XPU

      DO 40 IA=1,NSOUPO                                                         
        MSOUP1=IPCHP(IA)                                                        
        SEGINI,MSOUPO=MSOUP1                                                    
        IPCHP(IA)=MSOUPO                                                        
        MPOVA1=IPOVAL                                                           
        SEGINI,MPOVAL=MPOVA1                                                    
        IPOVAL=MPOVAL                                                           
        N =VPOCHA(/1)                                                           
        NC=VPOCHA(/2)                                                           
        DO 60 IC=1,NC                                                           
          DO 60 IB=1,N                                                          
            XTRA=VPOCHA(IB,IC)                                                  
            IF (XTRA.GT.0.) THEN                                                
              VPOCHA(IB,IC)=XTRA ** XPU                                         
            ELSE                                                                
              VPOCHA(IB,IC)=0.                                                  
              IF (XTRA.LT.0.) IRET=0                                            
            ENDIF                                                               
  60    CONTINUE                                                                
        SEGDES MPOVAL                                                           
        SEGDES MSOUPO                                                           
  40  CONTINUE                                                                  
      GOTO 999
      
c----------------------------------------------------------------------
c     Cas : Y**0.5
 100  CONTINUE  
 
      DO 140 IA=1,NSOUPO                                                         
        MSOUP1=IPCHP(IA)                                                        
        SEGINI,MSOUPO=MSOUP1                                                    
        IPCHP(IA)=MSOUPO                                                        
        MPOVA1=IPOVAL                                                           
        SEGINI,MPOVAL=MPOVA1                                                    
        IPOVAL=MPOVAL                                                           
        N =VPOCHA(/1)                                                           
        NC=VPOCHA(/2)                                                           
        DO 160 IC=1,NC                                                           
          DO 160 IB=1,N                                                          
            XTRA=VPOCHA(IB,IC)                                                  
            IF (XTRA.GT.0.) THEN                                                
              VPOCHA(IB,IC)=sqrt(XTRA)
            ELSE                                                                
              VPOCHA(IB,IC)=0.                                                  
              IF (XTRA.LT.0.) IRET=0                                            
            ENDIF                                                               
 160    CONTINUE                                                                
        SEGDES MPOVAL                                                           
        SEGDES MSOUPO                                                           
 140  CONTINUE                                                                  
      GOTO 999
 
 
c----------------------------------------------------------------------
c     FIN DU PROGRAMME
 999  CONTINUE
      SEGDES MCHPOI  
C                                                                               
      IF (IRET.NE.0) THEN                                                       
        IPO2=MCHPOI                                                             
      ELSE                                                                      
        SEGSUP,MCHPOI                                                           
        IPO2=0                                                                  
      ENDIF                                                                     
C                                                                               
      RETURN                                                                    
      END