C INTEVO    SOURCE    PV        11/03/07    21:17:01     6885           
      SUBROUTINE INTEVO(IEVO,IR1,IR2,IAMOR,BETA, NEVOL)                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
************************************************************************        
*                                                                               
*                             I N T E V O                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     INTERPOLATION D'UNE COURBE D'UNE EVOLUTION.                               
*                                                                               
* MODULES UTILISES:                                                             
* -----------------                                                             
*                                                                               
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
* -----------                                                                   
*                                                                               
*     IEVO    (E)  POINTEUR SUR UNE EVOLUTION.                                  
*     IR1     (E)  NUMERO DE LA PREMIERE COURBE A INTERPOLER.                   
*     IR2     (E)  NUMERO DE LA DEUXIEME COURBE A INTERPOLER.                   
*     IAMOR   (E)  POINTEUR SUR LE LITREEL CORRESPONDANT A L'EVOLUTION.         
*     BETA    (E)  AMORTISSEMENT DE LA COURBE A INTERPOLER.                     
*     NEVOL   (S)  POINTEUR SUR L'EVOLUTION INTERPOLEE.                         
*                                                                               
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     LIONEL VIVAN       SEPTEMBRE 1988                                         
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
*     RECHERCHE DES DEUX COURBES                                                
*                                                                               
      MEVOLL = IEVO                                                             
      SEGACT MEVOLL                                                             
      COURB1 = IEVOLL(IR1)                                                      
      COURB2 = IEVOLL(IR2)                                                      
*                                                                               
*     RECUPERATION DES ABSCISSES ET DES ORDONNEES                               
*                                                                               
      KEVOLL = nint(COURB1 )
      SEGACT KEVOLL                                                             
      IPX1 = IPROGX                                                             
      IPY1 = IPROGY                                                             
      SEGDES KEVOLL                                                       
*                                                                               
      KEVOLL = nint(COURB2)
      SEGACT KEVOLL                                                             
      IPX2 = IPROGX                                                             
      IPY2 = IPROGY                                                             
      SEGDES KEVOLL                                                       
*                                                                               
*     RECUPERATION DES AMORTISSEMENTS CORRESPONDANT AUX COURBES                 
*                                                                               
      CALL EXTRA1(IAMOR,IR1,BETA1)                                              
      CALL EXTRA1(IAMOR,IR2,BETA2)                                              
      IF (IERR.NE.0) RETURN                                                     
*                                                                               
*     FUSION DES DEUX LISTREELS ABSCISSES  --->  NOUVELLES ABSCISSES            
*                                                                               
      CALL FUSLRE(IPX1,IPX2,IPX3)                                               
*                                                                               
*     ON INTERPOLE OU EXTRAPOLE POUR AVOIR DES ORDONNEES IDENTIQUES             
*                                                                               
      CALL DIMEN1(IPX1,LD1)                                                     
      CALL DIMEN1(IPX2,LD2)                                                     
      CALL DIMEN1(IPX3,LD3)                                                     
      IF (IERR.NE.0) RETURN                                                     
*                                                                               
      IF (LD3.NE.LD1) THEN                                                      
         CALL OPLREE(IPX1,8,IPX4)                                               
         CALL OPLREE(IPY1,8,IPY4)                                               
         CALL OPLREE(IPX3,8,IPX5)                                               
         CALL INTE33(IPX4,IPY4,IPX5,IPY5)                                       
         CALL OPLREE(IPY5,7,IPY1)                                               
         CALL DTLREE(IPX5)                                                      
         CALL DTLREE(IPY5)                                                      
         CALL DTLREE(IPX4)                                                      
         CALL DTLREE(IPY4)                                                      
      ENDIF                                                                     
      IF (LD3.NE.LD2) THEN                                                      
         CALL OPLREE(IPX2,8,IPX4)                                               
         CALL OPLREE(IPY2,8,IPY4)                                               
         CALL OPLREE(IPX3,8,IPX5)                                               
         CALL INTE33(IPX4,IPY4,IPX5,IPY5)                                       
         CALL OPLREE(IPY5,7,IPY2)                                               
         CALL DTLREE(IPX5)                                                      
         CALL DTLREE(IPY5)                                                      
         CALL DTLREE(IPX4)                                                      
         CALL DTLREE(IPY4)                                                      
      ENDIF                                                                     
*                                                                               
*     ON INTERPOLE OU EXTRAPOLE SUIVANT LA VALEUR DE L'AMORTISSEMENT            
*                                                                               
      ALPHA = (BETA - BETA1) / (BETA2 - BETA1)                                  
      CALL OPLREE(IPY1,8,IPY4)                                                  
      CALL OPLREE(IPY2,8,IPY5)                                                  
      CALL INTE44(IPY4,IPY5,ALPHA,IPY6)                                         
      CALL OPLREE(IPY6,7,IPY3)                                                  
      CALL DTLREE(IPY4)                                                         
      CALL DTLREE(IPY5)                                                         
      CALL DTLREE(IPY6)                                                         
*                                                                               
*     CREATION DE LA NOUVELLE EVOLUTION                                         
*                                                                               
      N = 1                                                                     
      SEGINI MEVOL1                                                             
      NEVOL = MEVOL1                                                            
*                                                                               
      MEVOL1.IEVOLL(1) = IEVOLL(IR1)                                            
      KEVOL1 = MEVOL1.IEVOLL(1)                                                 
      SEGACT KEVOL1                                                             
      KEVOL1.IPROGX = IPX3                                                      
      KEVOL1.IPROGY = IPY3                                                      
      SEGDES KEVOL1                                                             
*                                                                               
      SEGDES,MEVOL1,MEVOLL                                                
*                                                                               
      END