C VERIDY    SOURCE    CHAT      05/01/13    04:05:32     5004           
      SUBROUTINE VERIDY(IBO,IPX,ICHA,ITOUS, ILEX,ITYPE)                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
C=======================================================================        
C   POUR OPERATEUR  EVOL : POUR UN DYNAMIQUE,                                   
C   VERIFIE  LA COMPATIBILITE DU MSOLUT ET DU LISTREEL .                        
C   RETOUR :DANS ILEX UN SEGMENT MSOLEN QUI CONTIENT LA LISTE DES CHAMPS        
C           A PRENDRE.                                                          
C          :ITYPE ='TEMPS  '                                                    
C   CREATION    : 14/10/85                                                      
C   PROGRAMMEUR : FARVACQUE                                                     
C=======================================================================        
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMSOLUT                                                                    
-INC SMLREEL                                                                    
      CHARACTER*8 ITYPE                                                         
C                                                                               
      IF(IPX.EQ.0.AND.ITOUS.EQ.0) THEN                                          
          MOTERR(1:8)='LISTREEL'                                                
          CALL ERREUR(37)                                                       
C         DYNAMIQUE ON ATTEND UN PROG                                           
          GOTO 5000                                                             
      ENDIF                                                                     
C                                                                               
C **** ON VERIFIE D'ABORD QUE LA SUITE IPX EST CROISSANTE                       
C                                                                               
      IF(IPX.EQ.0) THEN                                                         
         JG=0                                                                   
         SEGINI MLREEL                                                          
         IPX=MLREEL                                                             
      ELSE                                                                      
         MLREEL=IPX                                                             
         SEGACT MLREEL                                                          
         LCAS=PROG(/1)                                                          
         DO 161 I=2,LCAS                                                        
         IF(PROG(I).GT.PROG(I-1)) GOTO 161                                      
         CALL ERREUR(249)                                                       
C        LA SUITE DE REELS DOIT ETRE CROISSANTE                                 
         GOTO  5000                                                             
  161    CONTINUE                                                               
      ENDIF                                                                     
C                                                                               
      MSOLUT=IBO                                                                
      SEGACT MSOLUT                                                             
      MSOLRE=MSOLIS(1)                                                          
      SEGACT MSOLRE                                                             
      LTE=SOLRE(/1)                                                             
      IF (ITOUS.EQ.0) THEN                                                      
        N=LCAS                                                                  
      ELSE                                                                      
        N=LTE                                                                   
      ENDIF                                                                     
      SEGINI MSOLEN                                                             
      MSOLE1=MSOLIS(ICHA)                                                       
      SEGACT MSOLE1                                                             
      IF(ITOUS.EQ.1) GOTO 10                                                    
C                                                                               
      IF(LTE.LT.LCAS.OR.SOLRE(LTE).LT.PROG(LCAS)) GOTO 140                      
C                                                                               
      JJ1=1                                                                     
      DO 152 I=1,LCAS                                                           
      T1=PROG(I)                                                                
      IF(T1.EQ.0.) THEN                                                         
          IF(SOLRE(1).EQ.0.) THEN                                               
            JJ1=2                                                               
            ISOLEN(1)=MSOLE1.ISOLEN(1)                                          
            GOTO 152                                                            
          ENDIF                                                                 
          GOTO 140                                                              
      ENDIF                                                                     
      J1=JJ1                                                                    
      DO 153 J=J1,LTE                                                           
      T2=SOLRE(J)                                                               
      TR=ABS((T2-T1)/T1)                                                        
      PRECI = (SOLRE(LTE) - SOLRE(1))/(LTE*1000.)                               
      IF(TR.LT.PRECI) THEN                                                      
           JJ1=J+1                                                              
           K=MSOLE1.ISOLEN(J)                                                   
           IF(K.EQ.0) THEN                                                      
                GOTO 140                                                        
           ELSE                                                                 
                ISOLEN(I)=K                                                     
           ENDIF                                                                
           GOTO 152                                                             
      ENDIF                                                                     
      IF(T2.GT.T1) GOTO 140                                                     
  153 CONTINUE                                                                  
  152 CONTINUE                                                                  
      GOTO 11                                                                   
C                                                                               
  140 CONTINUE                                                                  
      MOTERR(1:8)='SOLUTION'                                                    
      MOTERR(9:16)='LISTREEL'                                                   
      CALL ERREUR(135)                                                          
      GOTO 5000                                                                 
C                                                                               
C  ****** CAS ITOUS=1 *************************                                 
C                                                                               
   10 CONTINUE                                                                  
      II=0                                                                      
      INN=0                                                                     
      DO 1010 J=1,LTE                                                           
      K=MSOLE1.ISOLEN(J)                                                        
      IF(K.NE.0) INN=INN+1                                                      
 1010 CONTINUE                                                                  
      JG0=PROG(/1)                                                              
      JG=JG0+INN                                                                
      SEGADJ MLREEL                                                             
      INN=1                                                                     
      DO 101 J=1,LTE                                                            
      K=MSOLE1.ISOLEN(J)                                                        
      IF(K.EQ.0) GOTO 101                                                       
      PROG(JG0+INN)=SOLRE(J)                                                    
      INN=INN+1                                                                 
      II=II+1                                                                   
      ISOLEN(II)=K                                                              
  101 CONTINUE                                                                  
      N=II                                                                      
      SEGADJ MSOLEN                                                             
C                                                                               
  11  CONTINUE                                                                  
      ILEX=MSOLEN                                                               
      SEGDES MSOLRE,MSOLE1,MSOLUT                                               
      SEGDES MLREEL,MSOLEN                                                      
      ITYPE='TEMPS'                                                             
 5000 CONTINUE                                                                  
      RETURN                                                                    
      END