C VERITA    SOURCE    CHAT      06/03/29    21:37:02     5360           
      SUBROUTINE VERITA(ITABO,IPX,ICHA,ITOUS, ILEX,ITYPE)                       
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
C=======================================================================        
C   POUR OPERATEUR  EVOL SOLU   "TABLE"                                         
C   VERIFIE  LA COMPATIBILITE DU CONTENU DE LA TABLE ET DU LISTREEL IPX         
C   RETOUR :DANS ILEX UN SEGMENT MLENTI QUI CONTIENT LA LISTE DES CHAMPS        
C           A PRENDRE.                                                          
C          :ITYPE ='TEMPS  '                                                    
C   CREATION    : 24/08/89                                                      
C   PROGRAMMEUR : LENA                                                          
C=======================================================================        
      CHARACTER*8 ITYPE,ICHA2,MOMO,MOE,MOT,CHARRE                                      
      CHARACTER*15 ICHAI                                                        
      CHARACTER*4 MCHA                                                          
      LOGICAL L0,L1                                                             
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMTABLE                                                                    
-INC SMLENTI                                                                    
-INC SMSOLUT                                                                    
-INC SMLREEL                                                                    
      DATA MOT /'MOT     '/                                                     
      DATA MOE /'ENTIER  '/                                                     
      DATA ICHAI /'TEMPS_DE_SORTIE'/                                            
C======================================================================         
C     SI ITOUS=0, ON DOIT AVOIR UN IPX EN DONNEE                                
      IF(IPX.EQ.0.AND.ITOUS.EQ.0) THEN                                          
          MOTERR(1:8)='LISTREEL'                                                
          CALL ERREUR(37)                                                       
          GOTO 5000                                                             
      ENDIF                                                                     
C --- ON RECUPERE LE  POINTEUR SUR LA LISTE  DES PAS DE SORTIE                  
      LBO=0                                                                     
      CALL ACCTAB(ITABO,MOT,I0,X0,ICHAI,L0,IRET0,                               
     1           'LISTREEL',I1,X1,ICHA2,L1,LBO)                                 
      MLREEL=LBO                                                                
       SEGACT MLREEL                                                            
         LTE  =PROG(/1)                                                         
       SEGDES MLREEL                                                            
         IDEPAR=0                                                               
*         CALL ECROBJ('TABLE',ITABO)                                            
*         CALL INDETA                                                           
*         CALL LIROBJ('TABLE',ITABIN,1,IRETAB)                                  
*         IF (IERR.NE.0) RETURN                                                 
*                                                                               
*        Boucle sur les indices de la table MTABLE:                             
*                                                                               
*         MTABLE=ITABIN                                                         
          MTABLE=ITABO                                                          
         SEGACT MTABLE                                                          
         NINDIC = MLOTAB                                                        
         DO 100 INDICE = 1 , NINDIC                                             
         I0= INDICE                                                             
*        MOMO =MOE                                                              
*        CALL ACCTAB(ITABIN,'ENTIER  ',I0,X0,' ',L0,IRET0,                      
*    *                           MOMO ,I1,X1,CHARRE,L1,IRET1)                      
*        IF (MOMO .EQ.MOE) THEN                                                 
         IF ( MTABTI(INDICE).EQ.MOE) THEN                                       
              IDEPAR=INDICE                                                     
              GO TO 110                                                         
         ENDIF                                                                  
  100 CONTINUE                                                                  
  110 SEGDES MTABLE                                                             
                                                              
C-----------------------------                                                  
      IF (ITOUS.EQ.1) GO TO 10                                                  
C-----------------------------                                                  
C------ON NE PREND PAS TOUS LES PAS                                             
C **** ON VERIFIE D'ABORD QUE LA SUITE IPX EST CROISSANTE                       
C                                                                               
      IF(IPX.NE.0) THEN                                                         
         MLREE1=IPX                                                             
         SEGACT MLREE1                                                          
         LCAS=MLREE1.PROG(/1)                                                   
         DO 161 I=2,LCAS                                                        
         IF(MLREE1.PROG(I).GT.MLREE1.PROG(I-1)) GOTO 161                        
         CALL ERREUR(249)                                                       
C        LA SUITE DE REELS DOIT ETRE CROISSANTE                                 
         GOTO  5000                                                             
  161    CONTINUE                                                               
      ENDIF                                                                     
C--- ON VA CREER LA TABLE DES INDICES A PRENDRE                                 
       JG=LCAS                                                                  
      SEGINI MLENTI                                                             
C                                                                               
      MLREEL=LBO                                                                
       SEGACT MLREEL                                                            
         LTE  =PROG(/1)                                                         
      PRECI = (PROG(LTE)-PROG(1))/(LTE*100)                                     
*     PRECI = 1.E-3                                                             
      ITOS=1                                                                    
      DO 152 KJ=1,LCAS                                                          
      TSEAR = MLREE1.PROG(KJ)                                                   
      CALL PLACE3 (PROG,ITOS,LTE,TSEAR,IPOS,AR)                                 
      IF (AR.LE.PRECI) THEN                                                     
         GO TO 149                                                              
       ELSE                                                                     
          RAR=ABS(1.-AR)                                                        
           IF (RAR.LE.PRECI) THEN                                               
             IPOS=IPOS+1                                                        
             GO TO 149                                                          
           ELSE                                                                 
             MOTERR(1:8) = 'TABLE   '                                           
             MOTERR(9:16) ='LISTREEL'                                           
             CALL ERREUR(135)                                                   
             GO TO 5000                                                         
           ENDIF                                                                
       ENDIF                                                                    
 149  LECT(KJ) = IPOS                                                           
      ITOS=IPOS                                                                 
  152 CONTINUE                                                                  
      SEGDES MLREE1                                                             
      SEGDES MLREEL                                                             
*                                                                               
      JG=LCAS                                                                   
      SEGINI MLENT1                                                             
      MTAB1  = ITABO                                                            
      SEGACT MTAB1                                                              
       DO 120 I=1,LCAS                                                          
      IT=LECT(I)+IDEPAR-1                                                       
       MTAB2 = MTAB1.MTABIV(IT)                                                 
      SEGACT MTAB2                                                              
      MLENT1.LECT(I)= MTAB2.MTABIV(ICHA)                                        
      SEGDES MTAB2                                                              
  120 CONTINUE                                                                  
       SEGDES MLENT1                                                            
       SEGSUP MLENTI                                                            
      ILEX=MLENT1                                                               
      GO TO 5001                                                                
C                                                                               
C  ****** CAS ITOUS=1 *************************                                 
C                                                                               
   10 CONTINUE                                                                  
C                                                                               
      CALL COPIE4 (LBO, IPX)                                                    
      JG=LTE                                                                    
      SEGINI MLENTI                                                             
      MTAB1  = ITABO                                                            
      SEGACT MTAB1                                                              
      IT=IDEPAR-1                                                               
       DO 1110 I=1,LTE                                                          
      IT=IT+1                                                                   
       MTAB2 = MTAB1.MTABIV(IT)                                                 
      SEGACT MTAB2                                                              
      LECT  (I)= MTAB2.MTABIV(ICHA)                                             
      SEGDES MTAB2                                                              
 1110 CONTINUE                                                                  
       SEGDES MLENTI                                                            
  11  CONTINUE                                                                  
      ILEX=MLENTI                                                               
 5001 ITYPE='TEMPS'                                                             
      SEGDES MTAB1                                                              
      MLENTI = ILEX                                                             
      SEGACT MLENTI                                                             
      JGG=LECT(/1)                                                              
      SEGDES MLENTI                                                             
 5000 CONTINUE                                                                  
      RETURN                                                                    
      END