C EVCOMP    SOURCE    CHAT      05/01/12    23:46:49     5004           
      SUBROUTINE EVCOMP(ICOUL)                                                  
C=======================================================================        
C   OPTION COMP DE L'OPERATEUR EVOL                                             
C                                                                               
C   POUR RENTRER UN OBJET DE TYPE EVOLUTION DE SOUS TYPE COMPLEXE               
C   SYNTAXE :                                                                   
C                                                                               
C   EV1= EVOL (COUL) COMP  /(REIM)/  /('CHAINE CARAC')/  PRGX                   
C        ----        ----  /(MOPH)/                                             
C                                    /('CHAINE CARAC')/  PRGY1 ;                
C                                                                               
C                                    /('CHAINE CARAC')/  PRGY2 ;                
C                                                                               
C                                                                               
C   COUL   : COULEUR DE LA COURBE (FACULTATIVE)                                 
C                                                                               
C   PRGX   : LISTE DE REELS (ABSCISSES)                                         
C                                                                               
C   PRGY1  : LISTE DE REELS (PARTIE REELLE OU MODULE)                           
C                                                                               
C   PRGY2  : LISTE DE REELS (PARTIE IMAGINAIRE OU PHASE)                        
C                                                                               
C   CREATION    : 04/12/87                                                      
C   F. ROULLIER                                                                 
C======================================================================         
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
C                                                                               
      CHARACTER *72 TI                                                          
      CHARACTER*12 MOTITR                                                       
      CHARACTER*8 ITBLAN                                                        
      CHARACTER*4 MOTCMP(2,2),MOTOPT(2)                                         
      DATA MOTCMP/'MODU','PHAS','PREE','PIMA'/                                  
      DATA MOTOPT/'MOPH','REIM'/                                                
      LOPT=2                                                                    
C                                                                               
      CALL LIRMOT (MOTOPT,LOPT,IOPT,0)                                          
      IF (IOPT.EQ.0) IOPT=2                                                     
      N=2                                                                       
      SEGINI MEVOLL                                                             
      IPVO=MEVOLL                                                               
      TI(1:72)=TITREE                                                           
      IEVTEX=TI                                                                 
      ITYEVO='COMPLEXE'                                                         
C                                                                               
      SEGINI KEVOL1,KEVOL2                                                      
      IEVOLL(1)=KEVOL1                                                          
      IEVOLL(2)=KEVOL2                                                          
      KEVOL1.NUMEVX=ICOUL                                                       
      KEVOL2.NUMEVX=ICOUL                                                       
      KEVOL1.KEVTEX=TI                                                          
      KEVOL2.KEVTEX=TI                                                          
      KEVOL1.TYPX='LISTREEL'                                                    
      KEVOL1.TYPY='LISTREEL'                                                    
      KEVOL2.TYPX='LISTREEL'                                                    
      KEVOL2.TYPY='LISTREEL'                                                    
C                                                                               
      DO 110 K=1,2                                                              
      DO 20 J=1,K                                                               
C *** TITRE SOUS FORME DE CHAINE DE CARACTERES                                  
      MOTITR=' '                                                                
      CALL LIRCHA(MOTITR,0,IRETOU)                                              
      IF(IRETOU.EQ.0) GOTO 12                                                   
          IF (K.EQ.1) THEN                                                      
        KEVOL1.NOMEVX=MOTITR                                                    
        KEVOL2.NOMEVX=MOTITR                                                    
          ELSE                                                                  
        IF(J.EQ.1) KEVOL1.NOMEVY=MOTITR                                         
        IF(J.EQ.2) KEVOL2.NOMEVY=MOTITR                                         
          ENDIF                                                                 
C *** LECTURE DE     LISTREEL                                                   
   12 CONTINUE                                                                  
      CALL LIROBJ('LISTREEL',IMOT,1,IRET)                                       
      IF(IERR.NE.0) RETURN                                                      
        IF (K.EQ.1) THEN                                                        
C                              ABSCISSES DES 2 COURBES                          
           KEVOL1.IPROGX=IMOT                                                   
           KEVOL2.IPROGX=IMOT                                                   
           MLREEL=IMOT                                                          
           SEGACT MLREEL                                                        
           LX  = MLREEL.PROG(/1)                                                
           SEGDES MLREEL                                                        
        ELSE                                                                    
             IF (J.EQ.1) THEN                                                   
C                                    PREMIERE COURBE                            
                  KEVOL1.IPROGY=IMOT                                            
                  KEVOL1.NUMEVY=MOTCMP(1,IOPT)                                  
                  MLREEL=IMOT                                                   
                  SEGACT MLREEL                                                 
                  LY1 = MLREEL.PROG(/1)                                         
                  SEGDES MLREEL                                                 
             ELSE                                                               
C                                    DEUXIEME COURBE                            
                  KEVOL2.IPROGY=IMOT                                            
                  KEVOL2.NUMEVY=MOTCMP(2,IOPT)                                  
                  MLREEL=IMOT                                                   
                  SEGACT MLREEL                                                 
                  LY2 = MLREEL.PROG(/1)                                         
                  SEGDES MLREEL                                                 
             ENDIF                                                              
        ENDIF                                                                   
   20 CONTINUE                                                                  
  110 CONTINUE                                                                  
      SEGDES KEVOL1,KEVOL2                                                      
C                                                                               
        IF((LX.NE.LY1).OR.(LY1.NE.LY2)) THEN                                    
          CALL ERREUR(263)                                                      
C     LES 3 PROGRESSIONS DOIVENT ETRE DE MEME LONGUEUR                          
          GO TO 1000                                                            
        ENDIF                                                                   
C                                                                               
      SEGDES MEVOLL                                                             
      CALL ECROBJ('EVOLUTIO',IPVO)                                              
      RETURN                                                                    
 1000 CONTINUE                                                                  
      RETURN                                                                    
      END