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 PPARAM
-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