C SAUF      SOURCE    JC220346  14/12/09    21:15:11     8315
      SUBROUTINE SAUF
C
C
C     CET OPERATEUR ENLEVE AU SEGMENT LECT1(RESP. MLREE1) LES ELEMENTS
C     DU SEGMENT LECT2(RESP. MLREE2) ET LES MET DANS MLENTI(RESP.MLREEL)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMLREEL
-INC SMLMOTS

      PARAMETER (NCLE = 1)
      CHARACTER*4 LICLE(NCLE)
      DATA LICLE / 'NOCA' /

      CHARACTER*4  CAR1,CAR2
      CHARACTER*26 MINUSC,MAJUSC
      DATA MINUSC / 'abcdefghijklmnopqrstuvwxyz' /
      DATA MAJUSC / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /

*      MOT-CLE NOCA
       INOCA = 0
  500  CONTINUE
         CALL LIRMOT(LICLE,NCLE,IMOT,0)
         IF (IERR.NE.0) RETURN
         IF (IMOT.EQ.1) THEN
            INOCA = 1
            GOTO 500
         ENDIF

*      PRECISION POUR TEST SUR LISTREEL
       CALL LIRREE(RCRIT,0,ICRIT)
       IF (IERR.NE.0) RETURN
       IF (ICRIT.NE.0) RCRIT=ABS(RCRIT)


C
C  **** OPERATION SUR MLENTI
C
      CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
      IF(IRETOU.EQ.0) GO TO 10
      SEGACT MLENT1
      N1=MLENT1.LECT(/1)

      CALL LIROBJ('LISTENTI',MLENT2,1,IRETOU)
      IF(IERR.NE.0) RETURN

      JG=N1
      SEGINI MLENTI
      IF(N1.EQ.0) GO TO 4901

      SEGACT MLENT2
      N2=MLENT2.LECT(/1)

      JG=0
      DO 1 I=1,N1
      IF(N2.EQ.0) GO TO 3
      DO 2 J=1,N2
      IF(MLENT1.LECT(I).EQ.MLENT2.LECT(J)) GO TO 1
 2    CONTINUE
 3    CONTINUE
      JG=JG+1
      LECT(JG)=MLENT1.LECT(I)
 1    CONTINUE
      SEGADJ MLENTI
      SEGDES MLENT2

 4901 CONTINUE
      SEGDES MLENT1
      CALL ECROBJ('LISTENTI',MLENTI)
      SEGDES MLENTI
      GO TO 5000
C
C  **** OPERATION SUR DES MLREEL
C
 10   CONTINUE

      CALL LIROBJ('LISTREEL',MLREE1,0,IRETOU)
      IF(IRETOU.EQ.0) GO TO 100
      SEGACT MLREE1
      N1=MLREE1.PROG(/1)

      CALL LIROBJ('LISTREEL',MLREE2,1,IRETOU)
      IF(IERR.NE.0)RETURN

      JG=N1
      SEGINI MLREEL
      IF(N1.EQ.0) GO TO 4902

      SEGACT MLREE2
      N2=MLREE2.PROG(/1)

      JG=0
      IF (ICRIT.EQ.0) THEN
          DO 11 I=1,N1
          IF(N2.EQ.0) GO TO 13
          DO 12 J=1,N2
          IF(MLREE1.PROG(I).EQ.MLREE2.PROG(J)) GO TO 11
 12       CONTINUE
 13       CONTINUE
          JG=JG+1
          PROG(JG)=MLREE1.PROG(I)
 11       CONTINUE
      ELSE
          DO 14 I=1,N1
          IF(N2.EQ.0) GO TO 16
          DO 15 J=1,N2
          IF (ABS(MLREE1.PROG(I)-MLREE2.PROG(J)).LT.RCRIT) GO TO 14
 15       CONTINUE
 16       CONTINUE
          JG=JG+1
          PROG(JG)=MLREE1.PROG(I)
 14       CONTINUE
      ENDIF
      SEGADJ MLREEL
      SEGDES MLREE2

 4902 CONTINUE
      SEGDES MLREE1
      CALL ECROBJ('LISTREEL',MLREEL)
      SEGDES MLREEL
      GO TO 5000
C
C  **** OPERATION SUR DES MLMOTS
C
 100  CONTINUE

      CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU)
      IF(IRETOU.EQ.0) GO TO 20
      SEGACT MLMOT1
      N1=MLMOT1.MOTS(/2)

      CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
      IF(IERR.NE.0)RETURN

      JGN=4
      JGM=N1
      SEGINI MLMOTS
      IF (N1.EQ.0) GO TO 4903

      SEGACT MLMOT2
      N2=MLMOT2.MOTS(/2)

      JGM=0
      IF (INOCA.EQ.1) THEN
          JGN1=MLMOT1.MOTS(/1)
          JGN2=MLMOT2.MOTS(/1)

          DO 111 I=1,N1
          IF(N2.EQ.0) GO TO 113
*         Passage en majuscules pour MLMOT1
          CAR1=MLMOT1.MOTS(I)
          DO K=1,JGN1
            ICAR = INDEX(MINUSC,CAR1(K:K))
            IF (ICAR.NE.0) CAR1(K:K) = MAJUSC(ICAR:ICAR)
          ENDDO
          DO 112 J=1,N2
*         Passage en majuscules pour MLMOT2
          CAR2=MLMOT2.MOTS(J)
          DO K=1,JGN2
            ICAR = INDEX(MINUSC,CAR2(K:K))
            IF (ICAR.NE.0) CAR2(K:K) = MAJUSC(ICAR:ICAR)
          ENDDO
          IF(CAR1.EQ.CAR2) GO TO 111
 112      CONTINUE
 113      CONTINUE
          JGM=JGM+1
          MOTS(JGM)=MLMOT1.MOTS(I)
 111      CONTINUE
      ELSE
          DO 114 I=1,N1
          IF(N2.EQ.0) GO TO 116
          DO 115 J=1,N2
          IF(MLMOT1.MOTS(I).EQ.MLMOT2.MOTS(J)) GO TO 114
 115      CONTINUE
 116      CONTINUE
          JGM=JGM+1
          MOTS(JGM)=MLMOT1.MOTS(I)
 114      CONTINUE
      ENDIF

      SEGADJ MLMOTS
      SEGDES MLMOT2

 4903 CONTINUE
      SEGDES MLMOT1
      CALL ECROBJ('LISTMOTS',MLMOTS)
      SEGDES MLMOTS

 5000 CONTINUE
      RETURN
C
C    PAS D OPERANDE CORRECTE TROUVE
C
 20   CALL QUETYP(MOTERR(1:8),0,IRETOU)
      IF(IRETOU.NE.0) THEN
         CALL ERREUR (39)
      ELSE
         CALL ERREUR(533)
      ENDIF
      RETURN
      END